Browse code

(thue.tal) Added a Thue esolang interpreter

Devine Lu Linvega authored on 23/07/2022 19:59:47
Showing 4 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,15 @@
1
+X::=~_
2
+Y::=~*
3
+Z::=~`
4
+_.::=._X
5
+_*::=*_Y
6
+._|::=.Z-|
7
+*_|::=Z
8
+..-::=.-.
9
+**-::=*-.
10
+*.-::=*-*
11
+.*-::=.-*
12
+@.-::=@_.
13
+@*-::=@_*
14
+::=
15
+@_*...............................|
0 16
new file mode 100644
... ...
@@ -0,0 +1,155 @@
1
+( thue interpreter
2
+	usage: thue.rom demo.t )
3
+
4
+|10 @Console &vector $2 &read $1 &pad $5 &write $1
5
+|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
6
+
7
+|0000
8
+
9
+@src $40
10
+@ptr $2
11
+@len $2
12
+
13
+|0100 ( -> )
14
+
15
+	;on-console .Console/vector DEO2
16
+
17
+BRK
18
+
19
+@on-console ( -> )
20
+
21
+	;src STH2
22
+
23
+	( read )
24
+	.Console/read DEI
25
+	DUP #20 LTH OVR #7f GTH ORA ,&end JCN
26
+	STH2kr ;slen JSR2 #003f GTH2 ,&end JCN
27
+		STH2r ;sput JSR2 BRK
28
+		&end
29
+	POP
30
+
31
+	( parse )
32
+	STH2r .File/name DEO2
33
+	#0001 .File/length DEO2
34
+	;program .ptr STZ2
35
+	&s
36
+		;&buf .File/read DEO2
37
+		.File/success DEI2 #0000 EQU2 ,&eof JCN
38
+		[ LIT &buf $1 ] ;walk JSR2
39
+		,&s JMP
40
+	&eof
41
+
42
+	( assemble )
43
+	;program/assembly .ptr STZ2
44
+	;program
45
+	&w
46
+		( save ) DUP2 .ptr LDZ2 STA2
47
+		( incr ) .ptr LDZ2k INC2 INC2 ROT STZ2
48
+		( next ) &eos INC2 LDAk ,&eos JCN INC2
49
+		LDAk ,&w JCN
50
+
51
+	( save acc )
52
+	INC2 ;program/accumulator ;scpy JSR2
53
+
54
+	( run )
55
+	&eval ,step JSR ,&eval JCN
56
+	#010f DEO
57
+
58
+BRK
59
+
60
+@step ( -- done )
61
+
62
+	;program/assembly
63
+	&while
64
+		DUP2 ;run-rule JSR2 ,&found JCN
65
+		#0004 ADD2 LDA2k ORA ,&while JCN
66
+	POP2
67
+	#00
68
+
69
+JMP2r
70
+	&found #01 JMP2r
71
+
72
+@walk ( char -- )
73
+
74
+	.ptr LDZ2 STA
75
+
76
+	( check for left-side )
77
+	.ptr LDZ2 #0002 SUB2 ;&marker ;scmp JSR2 #01 NEQ ,&no-marker JCN
78
+		#00 .ptr LDZ2 #0002 SUB2 STA
79
+		.ptr LDZ2k #0002 SUB2 ROT STZ2
80
+		.len LDZ2k INC2 ROT STZ2
81
+		&no-marker
82
+	( check for right-side )
83
+	.ptr LDZ2 LDA #0a NEQ ,&no-lb JCN
84
+		#00 .ptr LDZ2 STA
85
+		&no-lb
86
+	.ptr LDZ2k INC2 ROT STZ2
87
+
88
+JMP2r
89
+	&marker "::= $1
90
+
91
+@run-rule ( rule* -- )
92
+
93
+	LDA2k ,&a STR2
94
+	INC2 INC2 LDA2 ,&b STR2
95
+
96
+	;program/accumulator
97
+	&w
98
+		[ LIT2 &a $2 ] OVR2 ;sseg JSR2 #01 NEQ ,&no-found JCN
99
+			,&b LDR2 LDA LIT '~ EQU ,&output JCN
100
+			( shift ) DUP2 [ ,&b LDR2 ;slen JSR2 ,&a LDR2 ;slen JSR2 SUB2 ] ;ssft JSR2
101
+			( write ) [ LIT2 &b $2 ] SWP2 OVR2 ;slen JSR2 ;mcpy JSR2 
102
+			POP2 #01 JMP2r
103
+			&no-found
104
+		INC2 LDAk ,&w JCN
105
+	POP2
106
+	#00
107
+
108
+JMP2r
109
+	&output
110
+		,&a LDR2 ;slen JSR2 #0000 SWP2 SUB2 ;ssft JSR2
111
+		POP2 ,&b LDR2 INC2
112
+		LDAk LIT '` NEQ ,&no-lb JCN
113
+			#0a18 DEO #01 JMP2r
114
+			&no-lb
115
+		,print-str JSR #01
116
+	JMP2r
117
+
118
+@print-str ( str* -- )
119
+
120
+	&while
121
+		LDAk #18 DEO
122
+		INC2 LDAk ,&while JCN
123
+	POP2
124
+
125
+JMP2r
126
+
127
+@ssft ( str* len* -- )
128
+
129
+	STH2 DUP2k ;slen JSR2 ADD2 STH2r
130
+	DUP2 #8000 GTH2 ,&l JCN
131
+	ORAk ,&r JCN
132
+	POP2 POP2 POP2
133
+
134
+JMP2r
135
+	&l #8000 SWP2 SUB2 #8000 ADD2 ,msfl JSR JMP2r
136
+	&r ,msfr JSR JMP2r
137
+
138
+( stdlib )
139
+
140
+@mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ADD2 SWP2 &l LDAk STH2kr STA INC2r INC2 GTH2k ,&l JCN POP2 POP2 POP2r JMP2r
141
+@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
142
+@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
143
+
144
+@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ,&w JCN JMP2r
145
+@sput ( chr str* -- ) ,scap JSR STA JMP2r
146
+@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r
147
+@scpy ( src* dst* -- ) STH2 &w LDAk STH2kr STA INC2r INC2 LDAk ,&w JCN POP2 #00 STH2r STA JMP2r
148
+@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
149
+@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
150
+
151
+$10
152
+
153
+@program $4000
154
+	&assembly $4000
155
+	&accumulator $4000
... ...
@@ -34,7 +34,7 @@ BRK
34 34
 @on-button ( -> )
35 35
 
36 36
 	.Controller/key DEI
37
-	DUP #00 NEQ ,&no-null JCN
37
+	DUP ,&no-null JCN
38 38
 		POP BRK
39 39
 		&no-null
40 40
 	DUP #0d NEQ ,&no-enter JCN
... ...
@@ -321,7 +321,7 @@ JMP2r
321 321
 		EQUkr STHr #00 EQU ,&no-reached JCN
322 322
 			POP2r NIP2 ;dir/data ADD2 JMP2r
323 323
 			&no-reached
324
-		DUP2 ;dir/data ADD2 LDA #00 NEQ ,&no-lb JCN
324
+		DUP2 ;dir/data ADD2 LDA ,&no-lb JCN
325 325
 			INCr
326 326
 			&no-lb
327 327
 		INC2 GTH2k ,&loop JCN