Execute SNUSP/Tcl: Difference between revisions

From Rosetta Code
Content added Content deleted
mNo edit summary
(Split into Core and Modular versions)
Line 1: Line 1:
{{implementation|SNUSP}}{{collection|RCSNUSP}}[[Category:Tcl]]
{{implementation|SNUSP}}{{collection|RCSNUSP}}[[Category:Tcl]]
This is an interpreter for Modular [[SNUSP]]. Appears to work with correct SNUSP programs...
This is an interpreter for [[SNUSP]]. Appears to work with correct SNUSP programs...
<br clear=all>
<br clear=all>
==Core [[SNUSP]]==
<lang tcl>package require Tcl 8.5
<lang tcl>package require Tcl 8.5


Line 36: Line 37:
}
}


# An unbounded datastore
# An unbounded linear datastore
set data 0
set dptr 0
proc Get {} {
global data dptr
if {$dptr < 0} {
puts stderr "program error; data pointer too low"
return -code break
}
while {$dptr >= [llength $data]} {
lappend data 0
}
lindex $data $dptr
}
proc Set val {
global data dptr
if {$dptr < 0} {
puts stderr "program error; data pointer too low"
return -code break
}
while {$dptr >= [llength $data]} {
lappend data 0
}
lset data $dptr $val
}

# The main interpreter loop; $last is used for tracking whether
# to terminate output with a newline
set last 10
while 1 {
switch -- [Char] {
"/" {set move "[expr -[lindex $move 1]] [expr -[lindex $move 0]]"}
"\\" {set move [lreverse $move]}
"?" {if ![Get] Move}
"!" {Move}
">" {incr dptr}
"<" {incr dptr -1}
"+" {Set [expr [Get]+1]}
"-" {Set [expr [Get]-1]}
"." {puts -nonewline [format %c [set last [Get]]]}
"," {Set [read stdin 1]}
}
Move
}
if {$last != 10} {puts ""}</lang>

==Modular [[SNUSP]]==
<lang tcl>package require Tcl 8.5

# Basic I/O to read the program data and get ready for execution
set f [open [lindex $argv 0]]
set data [read $f]
close $f
fconfigure stdout -buffering none

# How to access the program
set pc {0 0}
set lineNum 0
foreach line [split $data \n] {
set idx [string first \$ $line]
if {$idx >= 0} {
set pc [list $lineNum $idx]
}
lappend program [split $line ""]
incr lineNum
}
set move {0 1}
proc Move {} {
global pc move
lset pc 0 [expr {[lindex $pc 0] + [lindex $move 0]}]
lset pc 1 [expr {[lindex $pc 1] + [lindex $move 1]}]
}
proc Char {} {
global program pc
set c [lindex $program $pc]
if {$c eq ""} {
return -code break
}
return $c
}

# An unbounded linear datastore
set data 0
set data 0
set dptr 0
set dptr 0

Revision as of 12:37, 22 May 2009

Execute SNUSP/Tcl is an implementation of SNUSP. Other implementations of SNUSP.
Execute SNUSP/Tcl is part of RCSNUSP. You may find other members of RCSNUSP at Category:RCSNUSP.

This is an interpreter for SNUSP. Appears to work with correct SNUSP programs...

Core SNUSP

<lang tcl>package require Tcl 8.5

  1. Basic I/O to read the program data and get ready for execution

set f [open [lindex $argv 0]] set data [read $f] close $f fconfigure stdout -buffering none

  1. How to access the program

set pc {0 0} set lineNum 0 foreach line [split $data \n] {

   set idx [string first \$ $line]
   if {$idx >= 0} {

set pc [list $lineNum $idx]

   }
   lappend program [split $line ""]
   incr lineNum

} set move {0 1} proc Move {} {

   global pc move
   lset pc 0 [expr {[lindex $pc 0] + [lindex $move 0]}]
   lset pc 1 [expr {[lindex $pc 1] + [lindex $move 1]}]

} proc Char {} {

   global program pc
   set c [lindex $program $pc]
   if {$c eq ""} {

return -code break

   }
   return $c

}

  1. An unbounded linear datastore

set data 0 set dptr 0 proc Get {} {

   global data dptr
   if {$dptr < 0} {
       puts stderr "program error; data pointer too low"
       return -code break
   }
   while {$dptr >= [llength $data]} {

lappend data 0

   }
   lindex $data $dptr

} proc Set val {

   global data dptr
   if {$dptr < 0} {
       puts stderr "program error; data pointer too low"
       return -code break
   }
   while {$dptr >= [llength $data]} {

lappend data 0

   }
   lset data $dptr $val

}

  1. The main interpreter loop; $last is used for tracking whether
  2. to terminate output with a newline

set last 10 while 1 {

   switch -- [Char] {

"/" {set move "[expr -[lindex $move 1]] [expr -[lindex $move 0]]"} "\\" {set move [lreverse $move]} "?" {if ![Get] Move} "!" {Move} ">" {incr dptr} "<" {incr dptr -1} "+" {Set [expr [Get]+1]} "-" {Set [expr [Get]-1]} "." {puts -nonewline [format %c [set last [Get]]]} "," {Set [read stdin 1]}

   }
   Move

} if {$last != 10} {puts ""}</lang>

Modular SNUSP

<lang tcl>package require Tcl 8.5

  1. Basic I/O to read the program data and get ready for execution

set f [open [lindex $argv 0]] set data [read $f] close $f fconfigure stdout -buffering none

  1. How to access the program

set pc {0 0} set lineNum 0 foreach line [split $data \n] {

   set idx [string first \$ $line]
   if {$idx >= 0} {

set pc [list $lineNum $idx]

   }
   lappend program [split $line ""]
   incr lineNum

} set move {0 1} proc Move {} {

   global pc move
   lset pc 0 [expr {[lindex $pc 0] + [lindex $move 0]}]
   lset pc 1 [expr {[lindex $pc 1] + [lindex $move 1]}]

} proc Char {} {

   global program pc
   set c [lindex $program $pc]
   if {$c eq ""} {

return -code break

   }
   return $c

}

  1. An unbounded linear datastore

set data 0 set dptr 0 proc Get {} {

   global data dptr
   if {$dptr < 0} {
       puts stderr "program error; data pointer too low"
       return -code break
   }
   while {$dptr >= [llength $data]} {

lappend data 0

   }
   lindex $data $dptr

} proc Set val {

   global data dptr
   if {$dptr < 0} {
       puts stderr "program error; data pointer too low"
       return -code break
   }
   while {$dptr >= [llength $data]} {

lappend data 0

   }
   lset data $dptr $val

}

  1. An unbounded stack

set stack {} proc Push {} {

   global stack pc move
   set save $pc
   Move
   lappend stack [list $pc $move]
   set pc $save

} proc Pop {} {

   global stack pc move
   if {[llength $stack] == 0} {

return -code break

   }
   lassign [lindex $stack end] pc move
   set stack [lrange $stack 0 end-1]

}

  1. The main interpreter loop; $last is used for tracking whether
  2. to terminate output with a newline

set last 10 while 1 {

   switch -- [Char] {

"/" {set move "[expr -[lindex $move 1]] [expr -[lindex $move 0]]"} "\\" {set move [lreverse $move]} "?" {if ![Get] Move} "!" {Move} ">" {incr dptr} "<" {incr dptr -1} "+" {Set [expr [Get]+1]} "-" {Set [expr [Get]-1]} "." {puts -nonewline [format %c [set last [Get]]]} "," {Set [read stdin 1]} "@" {Push} "#" {Pop}

   }
   Move

} if {$last != 10} {puts ""}</lang>