(thue.tal) Added a Thue esolang interpreter
This commit is contained in:
Devine Lu Linvega
parent
b94d0204c2
commit
c6ed7170e7
|
|
@ -0,0 +1,15 @@
|
|||
X::=~_
|
||||
Y::=~*
|
||||
Z::=~`
|
||||
_.::=._X
|
||||
_*::=*_Y
|
||||
._|::=.Z-|
|
||||
*_|::=Z
|
||||
..-::=.-.
|
||||
**-::=*-.
|
||||
*.-::=*-*
|
||||
.*-::=.-*
|
||||
@.-::=@_.
|
||||
@*-::=@_*
|
||||
::=
|
||||
@_*...............................|
|
||||
|
|
@ -0,0 +1,155 @@
|
|||
( thue interpreter
|
||||
usage: thue.rom demo.t )
|
||||
|
||||
|10 @Console &vector $2 &read $1 &pad $5 &write $1
|
||||
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|
||||
|
||||
|0000
|
||||
|
||||
@src $40
|
||||
@ptr $2
|
||||
@len $2
|
||||
|
||||
|0100 ( -> )
|
||||
|
||||
;on-console .Console/vector DEO2
|
||||
|
||||
BRK
|
||||
|
||||
@on-console ( -> )
|
||||
|
||||
;src STH2
|
||||
|
||||
( read )
|
||||
.Console/read DEI
|
||||
DUP #20 LTH OVR #7f GTH ORA ,&end JCN
|
||||
STH2kr ;slen JSR2 #003f GTH2 ,&end JCN
|
||||
STH2r ;sput JSR2 BRK
|
||||
&end
|
||||
POP
|
||||
|
||||
( parse )
|
||||
STH2r .File/name DEO2
|
||||
#0001 .File/length DEO2
|
||||
;program .ptr STZ2
|
||||
&s
|
||||
;&buf .File/read DEO2
|
||||
.File/success DEI2 #0000 EQU2 ,&eof JCN
|
||||
[ LIT &buf $1 ] ;walk JSR2
|
||||
,&s JMP
|
||||
&eof
|
||||
|
||||
( assemble )
|
||||
;program/assembly .ptr STZ2
|
||||
;program
|
||||
&w
|
||||
( save ) DUP2 .ptr LDZ2 STA2
|
||||
( incr ) .ptr LDZ2k INC2 INC2 ROT STZ2
|
||||
( next ) &eos INC2 LDAk ,&eos JCN INC2
|
||||
LDAk ,&w JCN
|
||||
|
||||
( save acc )
|
||||
INC2 ;program/accumulator ;scpy JSR2
|
||||
|
||||
( run )
|
||||
&eval ,step JSR ,&eval JCN
|
||||
#010f DEO
|
||||
|
||||
BRK
|
||||
|
||||
@step ( -- done )
|
||||
|
||||
;program/assembly
|
||||
&while
|
||||
DUP2 ;run-rule JSR2 ,&found JCN
|
||||
#0004 ADD2 LDA2k ORA ,&while JCN
|
||||
POP2
|
||||
#00
|
||||
|
||||
JMP2r
|
||||
&found #01 JMP2r
|
||||
|
||||
@walk ( char -- )
|
||||
|
||||
.ptr LDZ2 STA
|
||||
|
||||
( check for left-side )
|
||||
.ptr LDZ2 #0002 SUB2 ;&marker ;scmp JSR2 #01 NEQ ,&no-marker JCN
|
||||
#00 .ptr LDZ2 #0002 SUB2 STA
|
||||
.ptr LDZ2k #0002 SUB2 ROT STZ2
|
||||
.len LDZ2k INC2 ROT STZ2
|
||||
&no-marker
|
||||
( check for right-side )
|
||||
.ptr LDZ2 LDA #0a NEQ ,&no-lb JCN
|
||||
#00 .ptr LDZ2 STA
|
||||
&no-lb
|
||||
.ptr LDZ2k INC2 ROT STZ2
|
||||
|
||||
JMP2r
|
||||
&marker "::= $1
|
||||
|
||||
@run-rule ( rule* -- )
|
||||
|
||||
LDA2k ,&a STR2
|
||||
INC2 INC2 LDA2 ,&b STR2
|
||||
|
||||
;program/accumulator
|
||||
&w
|
||||
[ LIT2 &a $2 ] OVR2 ;sseg JSR2 #01 NEQ ,&no-found JCN
|
||||
,&b LDR2 LDA LIT '~ EQU ,&output JCN
|
||||
( shift ) DUP2 [ ,&b LDR2 ;slen JSR2 ,&a LDR2 ;slen JSR2 SUB2 ] ;ssft JSR2
|
||||
( write ) [ LIT2 &b $2 ] SWP2 OVR2 ;slen JSR2 ;mcpy JSR2
|
||||
POP2 #01 JMP2r
|
||||
&no-found
|
||||
INC2 LDAk ,&w JCN
|
||||
POP2
|
||||
#00
|
||||
|
||||
JMP2r
|
||||
&output
|
||||
,&a LDR2 ;slen JSR2 #0000 SWP2 SUB2 ;ssft JSR2
|
||||
POP2 ,&b LDR2 INC2
|
||||
LDAk LIT '` NEQ ,&no-lb JCN
|
||||
#0a18 DEO #01 JMP2r
|
||||
&no-lb
|
||||
,print-str JSR #01
|
||||
JMP2r
|
||||
|
||||
@print-str ( str* -- )
|
||||
|
||||
&while
|
||||
LDAk #18 DEO
|
||||
INC2 LDAk ,&while JCN
|
||||
POP2
|
||||
|
||||
JMP2r
|
||||
|
||||
@ssft ( str* len* -- )
|
||||
|
||||
STH2 DUP2k ;slen JSR2 ADD2 STH2r
|
||||
DUP2 #8000 GTH2 ,&l JCN
|
||||
ORAk ,&r JCN
|
||||
POP2 POP2 POP2
|
||||
|
||||
JMP2r
|
||||
&l #8000 SWP2 SUB2 #8000 ADD2 ,msfl JSR JMP2r
|
||||
&r ,msfr JSR JMP2r
|
||||
|
||||
( stdlib )
|
||||
|
||||
@mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ADD2 SWP2 &l LDAk STH2kr STA INC2r INC2 GTH2k ,&l JCN POP2 POP2 POP2r JMP2r
|
||||
@msfl ( b* a* len* -- ) STH2 SWP2 EQU2k ,&e JCN &l DUP2k STH2kr ADD2 LDA ROT ROT STA INC2 GTH2k ,&l JCN POP2 POP2 &e POP2r JMP2r
|
||||
@msfr ( b* a* len* -- ) STH2 EQU2k ,&e JCN &l DUP2 LDAk ROT ROT STH2kr ADD2 STA #0001 SUB2 LTH2k ,&l JCN POP2 POP2 &e POP2r JMP2r
|
||||
|
||||
@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ,&w JCN JMP2r
|
||||
@sput ( chr str* -- ) ,scap JSR STA JMP2r
|
||||
@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r
|
||||
@scpy ( src* dst* -- ) STH2 &w LDAk STH2kr STA INC2r INC2 LDAk ,&w JCN POP2 #00 STH2r STA JMP2r
|
||||
@scmp ( a* b* -- f ) STH2 &l LDAk LDAkr STHr ANDk #00 EQU ,&e JCN NEQk ,&e JCN POP2 INC2 INC2r ,&l JMP &e NIP2 POP2r EQU JMP2r
|
||||
@sseg ( a* b* -- f ) STH2 &l LDAk LDAkr STHr NEQ ,&e JCN INC2k LDA #00 EQU ,&e JCN INC2 INC2r ,&l JMP &e LDA LDAr STHr EQU JMP2r
|
||||
|
||||
$10
|
||||
|
||||
@program $4000
|
||||
&assembly $4000
|
||||
&accumulator $4000
|
||||
|
|
@ -34,7 +34,7 @@ BRK
|
|||
@on-button ( -> )
|
||||
|
||||
.Controller/key DEI
|
||||
DUP #00 NEQ ,&no-null JCN
|
||||
DUP ,&no-null JCN
|
||||
POP BRK
|
||||
&no-null
|
||||
DUP #0d NEQ ,&no-enter JCN
|
||||
|
|
|
|||
|
|
@ -321,7 +321,7 @@ JMP2r
|
|||
EQUkr STHr #00 EQU ,&no-reached JCN
|
||||
POP2r NIP2 ;dir/data ADD2 JMP2r
|
||||
&no-reached
|
||||
DUP2 ;dir/data ADD2 LDA #00 NEQ ,&no-lb JCN
|
||||
DUP2 ;dir/data ADD2 LDA ,&no-lb JCN
|
||||
INCr
|
||||
&no-lb
|
||||
INC2 GTH2k ,&loop JCN
|
||||
|
|
|
|||
Loading…
Reference in New Issue