# cons.tal -rw-r--r-- 1.4 KiB View raw
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
( uxnasm cons.tal cons.rom && uxncli cons.rom )

|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1

|0100

	nil
		;cat cons
			;dog cons
				;owl cons
	nil
		;ant cons
			;bat cons
				;cow cons
	nil
		SWP2 cons
			SWP2 cons
	( print ) echo #0a18 DEO
	#010e DEO
	#010f DEO

BRK

( cons )

@alloc ( -- cell* )

	[ LIT2 &next :memory ] DUP2 #0004 ADD2 ,&next STR2

JMP2r

@nil ( -- list* )

	alloc ;nil

@cons ( list* fn* -- list* )

	( car ) alloc STH2k STA2
	( cdr ) STH2kr INC2 INC2 STA2
	STH2r

JMP2r

@eval ( list* -- )

	&w
		LDA2k JSR2
		INC2 INC2 LDA2 LDA2k ;nil NEQ2 ?&w
	POP2

JMP2r

@last ( list* -- cell* )

	&w
		INC2 INC2 LDA2 LDA2k ;nil NEQ2 ?&w
	INC2 INC2

JMP2r

@join ( list-a* list-b* -- list-b* )

	STH2k last INC2 INC2 STA2 STH2r

JMP2r

@length ( list* -- length* )

	LIT2r 0000
	&w
		INC2 INC2 INC2r
		LDA2 LDA2k ;nil NEQ2 ?&w
	POP2 STH2r

JMP2r

@echo ( list* -- )

	#2818 DEO #2018 DEO
	&w
		LDA2k INC2 INC2 LDA2 ;nil EQU2 ?&value
			( list ) LDA2k echo !&resume
			&value LDA2k LDA2 pstr #2018 DEO
		&resume
		INC2 INC2 LDA2
		LDA2k ;nil NEQ2 ?&w
	POP2
	#2918 DEO #2018 DEO

JMP2r

@pstr ( str* -- )

	&w
		LDAk #18 DEO
		INC2 LDAk ?&w
	POP2

JMP2r

( some functions ) [
	@cat =dict/cat :nil @dog =dict/dog :nil @bat =dict/bat :nil
	@ant =dict/ant :nil @owl =dict/owl :nil @cow =dict/cow :nil ]

@dict [
	&cat "cat $1 &dog "dog $1 &bat "bat $1
	&ant "ant $1 &owl "owl $1 &cow "cow $1 ]

@memory