( dovem pro tle )

|00 @System/vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
|10 @Console/vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1

|000

	@token/buf $40
	@item/buf $40
	@goto/buf $40
	@symbol/buf $40

|100

@on-reset ( -> )
	;meta #06 DEO2
	;token/on-console .Console/vector DEO2
	( | Prefabs )
	;dict/identity syms/find-alloc-force POP2 BRK

@meta $1
	( name ) "Rejoice 0a
	( desc ) "Multiset 20 "Language 0a
	( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a
	( date ) "16 20 "Apr 20 "2026 $2

%u16/mod ( a* b* -- a%b* ) {
	DIV2k MUL2 SUB2 }

%u16/not-divisible ( u16* div* -- t ) {
	u16/mod #0000 NEQ2 }

%char/is-dec ( c -- t ) {
	LIT "0 SUB #0a LTH }

%tote/get-count ( id* -- count* ) {
	DUP2 ADD2 ;tote/buf ADD2 LDA2 }

%syms/get-name ( id* -- str* ) {
	DUP2 ADD2 ;syms/buf ADD2 LDA2 }

(
@|Token )

@token/on-console ( -> )
	.Console/read DEI
	( | handlers )
	DUP LIT "( NEQ ?{
		;&on-console-comment .Console/vector DEO2
		POP BRK }
	DUP LIT "[ NEQ ?{
		,&depth LDR INC ,&depth STR }
	DUP LIT "] NEQ ?{
		,&depth LDR #01 SUB ,&depth STR }
	[ LIT &depth $1 ] ?{
		DUP #20 GTH ?{
			/<parse>
			/<reset>
			#0a NEQ ?{ validator/get-error ?{ world/<eval> } }
			BRK } }
	[ LIT2 00 &ptr -&buf ] INCk ,&ptr STR
	STZ2
	BRK

@token/on-console-comment ( -> )
	[ LIT2 ") -Console/read ] DEI NEQ ?{ ;&on-console .Console/vector DEO2 }
	BRK

@token/<reset> ( -- )
	[ LIT2 -&buf _&ptr ] STR
	[ LIT2 00 -&buf ] STZ
	JMP2r

@token/<parse> ( -- )
	.&buf
	( exists ) LDZk ?{ POP JMP2r }
	( @label ) LDZk LIT "@ EQU ?/<parse-label>
	( 'quote ) LDZk LIT "' EQU ?/<parse-quote>
	;world/ptr LDA2 ROT /<parse-operand> !validator/<validate>

@token/<parse-operand> ( ztr -- )
	world/<push-scope>
	( >> )

@token/<parse-fraction> ( ztr -- )
	( num bag ) item/parse-any-push world/<pop-scope>
	world/<push-scope>
	LDZk LIT "/ EQU ?{
		( den bag [] ) world/<push-null>
		world/<pop-scope>
		POP JMP2r }
	INC
	( den bag ) item/parse-any-push world/<pop-scope>
	POP JMP2r

@token/<parse-quote> ( ztr -- )
	#0001 ;&quote-name syms/find-alloc DUP2 label/<create>
	world/<push-scope>
	world/<push-count-id>
	,&id LDR INC ,&id STR
	INC !/<parse-fraction>

	&quote-name "' [ &id "0 00 ]

@token/<parse-label> ( ztr -- )
	#00 SWP INC syms/find-alloc !label/<create>

(
@|World )

@world/<push-null> ( -- )
	#0000 DUP2
	( >> )

@world/<push-count-id> ( count* id* -- )
	/<push>
	( >> )

@world/<push> ( short* -- )
	[ LIT2 &ptr =&buf ] INC2k INC2 ,&ptr STR2
	STA2
	JMP2r

@world/<push-scope> ( -- )
	,&ptr LDR2 ,&scope STR2
	#ffff !/<push>

@world/<pop-scope> ( -- )
	,&ptr LDR2 [ LIT2 &scope $2 ] STA2
	JMP2r

@world/<print> ( addr* -- )
	,&ptr LDR2 SWP2 [ LIT2r 0800 ]
	&>l
		GTHkr STHr ?{
			( | trim at 8 fractions )
			LIT ". DUP char/<print>
			char/<print> !&print-end }
		DUP2 fraction/<print>
		#2019 DEO
		LDA2 LDA2 INCr GTH2k ?&>l
	&print-end ( to* from* . count* -- )
	POP2 POP2 POP2r #0a19 DEO
	JMP2r

@world/<eval> ( -- )
	tote/<clear>
	;&buf [ LIT2r 0001 ]
	&>w
		LDA2k ORA ?{ !&end }
		ORAkr STHr ?{ !&end }
		DUP2 tote/<apply>
		DUP2 /<print>
		goto/step INC2r !&>w

	&end ( addr* -- )
	POP2 tote/<print>
	( | steps )
	;dict/reached str/<print>
	STH2r u16/<print-dec>
	;dict/steps !str/<print>

%label/get-addr ( id* -- addr* ) {
	DUP2 ADD2 ;label/buf ADD2 }

%label/get ( id* -- addr* ) {
	label/get-addr LDA2 }

@label/<create> ( id* -- )
	/get-addr ;world/ptr LDA2 SWP2 STA2
	JMP2r

@goto/step ( addr* -- addr* )
	[ LIT2 -&buf _&ptr ] LDR EQU ?{
		POP2 ,&ptr LDR #02 SUB DUP ,&ptr STR
		LDZ2 JMP2r }
	LDA2 LDA2 JMP2r

@goto/<push> ( addr* -- )
	[ LIT &ptr -&buf ] INCk INC ,&ptr STR
	STZ2
	JMP2r

(
@|Bag/Items )

%item/next ( item* -- next* ) {
	#0004 ADD2 }

%item/not-quote ( item* -- item* t ) {
	LDA2k syms/get-name LDA LIT "' NEQ }

@item/<print> ( addr* -- )
	INC2k INC2 LDA2 SWP2 LDA2
	( >> )

@item/<print-count-id> ( count* name* -- )
	syms/<print-count-id>
	DUP2 #0002 LTH2 ?{
		[ LIT2 "^ 19 ] DEO
		OVR #80 AND ?{
			( num reg ) !u16/<print-dec> }
		( ref reg ) #7fff AND2 syms/get-name !str/<print> }
	POP2 JMP2r

@item/parse-any-push ( ztr -- ztr )
	LDZk LIT "[ EQU ?/parse-wrap-push
	( >> )

@item/parse-push ( ztr -- ztr )
	LDZk char/is-dec ?/parse-num-push
	( | not numeric )
	[ LIT2 -&buf _&ptr ] STR
	&>w
		LDZk DUP symbol/is-spacer ?/parse-sym-push
		[ LIT2 00 &ptr -&buf ] INCk ,&ptr STR
		STZ2
		INC2 !&>w

@item/parse-sym-push ( ztr c -- ztr count* id* )
	POP
	( identity ) [ LIT2 -&buf _&ptr ] LDR EQU ?world/<push-null>
	/walk-count ;&buf syms/find-alloc !world/<push-count-id>

@item/parse-num-push ( ztr -- ztr )
	dec-ztr/walk-u16
	( | check if not number 1 )
	DUP2 #0001 NEQ2 ?{ POP2 !world/<push-null> }
	( | check if not already prime )
	DUP2 primes/prime-id DUP ?/parse-prime
	POP
	( | factorize )
	( value ) [ LIT2r 0002 ]
	&>wpn
		DUP2 #0001 GTH2 ?{ POP2r POP2 JMP2r }
		DUP2 STH2kr u16/not-divisible ?{
			STH2kr
			( | Drain factor )
			[ LITr 00 ]
			&>wpf
				OVR2 OVR2 u16/mod ORA ?{
					INCr STH2k DIV2 STH2r !&>wpf }
			primes/prime-id #00 SWP #00 STHr SWP2 world/<push-count-id> }
		INC2r !&>wpn

@item/parse-prime ( ztr u16* id -- ztr )
	STH
	POP2 /walk-count #00 STHr !world/<push-count-id>

@item/parse-wrap-push ( ztr -- ztr )
	( walk [ ) INC ztr/walk-ws
	&>wwp
		/parse-push ztr/walk-ws LDZk [ LIT "] ] NEQ ?&>wwp
	( walk ] ) INC JMP2r

@item/walk-count ( ztr -- ztr count* )
	LDZk LIT "^ NEQ ?{
		INC LDZk char/is-dec ?{
			DUP symbol/walk
			( ref reg ) #00 ROT syms/find-alloc #8000 ORA2 JMP2r }
		( num reg ) !dec-ztr/walk-u16 }
	( def reg ) #0001 JMP2r

%fraction/den-length ( fraction* -- fraction* len* ) {
	LDA2k LDA2k SWP2 SUB2 }

%fraction/is-quoted ( fraction* -- fraction* t ) {
	DUP2 INC2k INC2
	( f* num[0].id ) LDA2
	( f* jump* = ) label/get EQU2 }

@fraction/<print> ( addr* -- )
	( num ) LDA2k OVR2 INC2 INC2 bag/<print>
	LDA2 INC2k INC2 LDA2 ORA ?{ POP2 JMP2r }
	( den is not [] ) [ LIT2 "/ 19 ] DEO
	( den ) LDA2k SWP2 INC2 INC2
	( >> )

@bag/<print> ( to* from* -- )
	item/not-quote ?{
		LIT "' char/<print>
		INC2 INC2 INC2 INC2 }
	( | Not quote )
	SUB2k #0004 GTH2 ?/<print-complex>
	&>lpb
		DUP2 item/<print>
		item/next GTH2k ?&>lpb
	POP2 POP2 JMP2r

@bag/<print-complex> ( to* from* -- )
	[ LIT2 "[ 19 ] DEO
	&>lpbc
		DUP2 item/<print>
		item/next EQU2k ?{ #2019 DEO }
		GTH2k ?&>lpbc
	POP2 POP2 [ LIT2 "] 19 ] DEO
	JMP2r

(
@|Tote )

%tote/get-addr ( id* -- addr* ) {
	DUP2 ADD2 ;tote/buf ADD2 }

%tote/next-cell ( addr* -- next* ) {
	INC2 INC2 }

%tote/lacks ( addr* -- addr* t ) {
	( addr* mod* ) /get-register OVR2 LDA2 /get-count GTH2 }

%tote/<mod-item> ( count* id* -- ) {
	tote/get-addr LDA2k ROT2 ADD2 SWP2 STA2 }

%tote/<take> ( item* -- ) {
	/get-register #0000 SWP2 SUB2 SWP2 LDA2 /<mod-item> }

@tote/get-register ( item* -- item* value* )
	INC2k INC2 LDA2 OVR #80 AND ?{ JMP2r }
	#7fff AND2 /get-addr LDA2 JMP2r

@tote/<put-print> ( item* name* -- )
	str/<set-print>
	( walk dot ) INC2 STH2
	/next-cell LDA2 #0000 SWP2 SUB2
	&>lpp
		STH2kr /<put-emit>
		INC2 ORAk ?&>lpp
	POP2 POP2r !str/<set-debug>

@tote/<put> ( item* -- )
	LDA2k syms/get-name
	( dup name* ) LDAk LIT ". EQU ?/<put-print>
	( pop name* ) POP2
	( | detect label )
	LDA2k label/get
	( dup addr* ) ORAk ?/<put-label>
	( pop addr* ) POP2 !queue/<put>

@tote/<put-emit> ( name* -- )
	LDAk LIT "# NEQ ?str/<print>
	INC2 syms/find-alloc /get-count !u16/<print-dec>

@tote/<put-label> ( item* addr* -- )
	NIP2 !goto/<push>

@tote/can-apply ( fraction* -- fraction* t )
	( den/from* ) LDA2k
	( den/from* den/to* ) LDA2k SWP2 /next-cell
	&>lca
		/lacks ?{ item/next GTH2k ?&>lca }
	EQU2 JMP2r

@tote/<apply> ( fraction* -- )
	/<print>
	/can-apply ?{ POP2 JMP2r }
	queue/<reset>
	( | put )
	LDA2k OVR2 /next-cell
	&>lap
		DUP2 /<put>
		item/next GTH2k ?&>lap
	POP2 POP2 LDA2
	( | take )
	LDA2k SWP2 /next-cell
	&>lat
		DUP2 /<take>
		item/next GTH2k ?&>lat
	POP2 POP2 !queue/<apply>

@tote/<print> ( -- )
	[ LIT2 "[ 19 ] DEO
	[ LIT2r ff00 ] ;&buf-end ;&buf
	&>lp
		LDA2k #0000 EQU2 ?{
			OVRr STHr ?{ #2019 DEO }
			LDA2k #00 STHkr item/<print-count-id>
			LIT2r 00ff AND2r }
		/next-cell INCr GTH2k ?&>lp
	POP2 POP2 POP2r [ LIT2 "] 19 ] DEO
	#2019 DEO
	JMP2r

@tote/<clear> ( -- )
	;&buf-end ;&buf
	&>lc
		#0000 OVR2 STA2
		/next-cell GTH2k ?&>lc
	POP2 POP2 JMP2r

@queue/<reset> ( -- )
	;&buf ,&ptr STR2
	JMP2r

@queue/<put> ( item* -- item* )
	( id* ) LDA2 /<push>
	( count* ) tote/get-register
	( >> )
	&<push> ( value* -- )
	[ LIT2 &ptr =&buf ] INC2k INC2 ,&ptr STR2
	STA2
	JMP2r

@queue/<apply> ( -- )
	,&ptr LDR2 ;&buf
	&>l
		EQU2k ?{
			INC2k INC2 LDA2 OVR2 LDA2 tote/<mod-item>
			item/next !&>l }
	POP2 POP2 JMP2r

(
@|Validator )

@validator/get-error ( -- exists )
	[ LIT &count $1 ] JMP2r

@validator/<set-error> ( msg* -- )
	[ LIT2 01 _&count ] STR
	;dict/err str/<print>
	str/<print>
	;token/buf str/<print>
	[ LIT2 ". 19 ] DEO
	#0a19 DEO
	JMP2r

@validator/<validate> ( ptr* -- )
	( num ) /<validate-fragment>
	( den ) /<validate-fragment>
	POP2 JMP2r

%validator/not-label ( ptr* -- ptr* ) {
	LDA2k label/get-addr LDA2 #0000 EQU2 }

@validator/<validate-fragment> ( ptr* -- )
	LDA2k SWP2 INC2 INC2
	( count labels ) [ LIT2r 0200 ]
	&>lvf
		/not-label ?{ INCr }
		/is-unique ?{ ;dict/err-assign /<set-error> }
		item/next GTH2k ?&>lvf
	POP2
	( | Multiple labels )
	GTHr STHr ?{ ;dict/err-jumps !/<set-error> }
	JMP2r

@validator/is-unique ( to* from* -- to* from* t )
	OVR2 OVR2 LDA2k STH2
	&>lf
		item/next EQU2k ?{
			LDA2k STH2kr NEQ2 ?{
				POP2 POP2 POP2r #00 JMP2r }
			!&>lf }
	POP2 POP2 POP2r #01 JMP2r

(
@|Dict )

@symbol/is-spacer ( c -- t )
	DUP LIT 21 LTH ?{
		DUP LIT "/ EQU ?{
			DUP LIT "] EQU ?{ LIT "^ EQU JMP2r } } }
	POP #01 JMP2r

@symbol/walk ( ztr -- ztr )
	&>ww
		LDZk /is-spacer ?{ INC2 !&>ww }
	JMP2r

@symbol/new ( str* -- str* )
	[ LIT2 -&buf _&ptr ] STR
	[ LIT2 00 -&buf ] STZ
	&>wn
		LDAk /is-spacer ?{
			LDAk [ LIT2 00 &ptr -&buf ] INCk ,&ptr STR
			STZ2
			INC2 !&>wn }
	POP2 ;&buf JMP2r

@syms/find-alloc ( str* -- id* )
	symbol/new
	( >> )

@syms/find-alloc-force ( str* -- id* )
	STH2
	,&ptr LDR2 ;&buf
	&>lfa
		LDA2k STH2kr str/compare ?{
			INC2 INC2 GTH2k ?&>lfa
		POP2
		( | alloc )
		;&buf SUB2 #01 SFT2 STH2r dict/alloc
		( | push )
		[ LIT2 &ptr =&buf ] INC2k INC2 ,&ptr STR2
		STA2
		JMP2r }
	( | found )
	POP2r NIP2 ;&buf SUB2 #01 SFT2 JMP2r

@syms/<print-count-id> ( id* -- )
	STH2k /get-name ORAk ?{
		POP2 DUP2r ADD2r STH2r primes/id-prime !u16/<print-dec> }
	POP2r
	( | quoted )
	LDAk LIT "' NEQ ?{ LDA !char/<print> }
	!str/<print>

@primes/id-prime ( id* -- prime* )
	;&lut ADD2 LDA2 JMP2r

@primes/prime-id ( prime* -- id )
	STH2
	#0000
	&>l
		DUP2k ADD2 /id-prime STH2kr EQU2 ?{ INC DUP ?&>l }
	POP2r NIP JMP2r

@dict/alloc ( src* -- ptr* )
	,&ptr LDR2 SWP2
	&>w
		LDAk DUP [ LIT2 &ptr =&buf ] INC2k ,&ptr STR2
		STA
		?{ POP2 JMP2r }
		INC2 !&>w

@dict/identity "[] 00 &reached 0a "Reached 20 "in 20 00 &steps 20 "steps. 0a00
	&err "Error: 20 00
	&err-assign "Duplicate 20 "in 20 00
	&err-jumps "Ambiguous 20 "jump 20 "in 20 00

(
@|Stdlib )

@dec-ztr/walk-u16 ( ztr -- ztr u16* )
	[ LIT2r 0000 ]
	&>w16
		LDZk LIT "0 SUB DUP #0a LTH ?{
			POP STH2r #7fff AND2 JMP2r }
		[ LIT2r 000a ] MUL2r [ LITr 00 ] STH
		ADD2r INC !&>w16

@char/<print-digit> ( d -- )
	LIT "0 ADD
	( >> )

@char/<print> ( c -- )
	[ LIT &port 19 ] DEO
	JMP2r

@char/escape ( byte -- byte )
	DUP [ LIT "t ] NEQ ?{ POP #09 JMP2r }
	[ LIT "n ] NEQ ?{ #0a JMP2r }
	#20 JMP2r

@ztr/walk-ws ( ztr -- ztr )
	LDZk #20 NEQ ?{ INC !/walk-ws }
	JMP2r

@str/compare ( a* b* -- bool )
	STH2
	&>wc
		LDAk ?{ &d LDA LDAr STHr EQU JMP2r }
		LDAk LDAkr STHr NEQ ?&d
		INC2 INC2r !&>wc

@str/<print> ( str* -- )
	LDAk DUP ?{ POP POP2 JMP2r }
	( | esc )
	[ LIT &esc 01 ] ?{
		DUP [ LIT "\ ] NEQ ?{ POP INC2 LDAk char/escape } }
	char/<print>
	INC2 !/<print>

@str/<set-print> ( -- )
	#18 ;char/port STA
	#00 ;&esc STA
	JMP2r

@str/<set-debug> ( -- )
	#19 ;char/port STA
	#01 ;&esc STA
	JMP2r

@u16/<print-dec> ( u16* -- )
	[ LIT2r ff00 ]
	&>read
		#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&>read
	POP2
	&>write
		NIP char/<print-digit>
		OVRr ADDr STHkr ?&>write
	POP2r JMP2r

(
@|Buffers )

@primes/lut [
	0001 0002 0003 0005 0007 000b 000d 0011
	0013 0017 001d 001f 0025 0029 002b 002f
	0035 003b 003d 0043 0047 0049 004f 0053
	0059 0061 0065 0067 006b 006d 0071 007f
	0083 0089 008b 0095 0097 009d 00a3 00a7
	00ad 00b3 00b5 00bf 00c1 00c5 00c7 00d3
	00df 00e3 00e5 00e9 00ef 00f1 00fb 0101
	0107 010d 010f 0115 0119 011b 0125 0133
	0137 0139 013d 014b 0151 015b 015d 0161
	0167 016f 0175 017b 017f 0185 018d 0191
	0199 01a3 01a5 01af 01b1 01b7 01bb 01c1
	01c9 01cd 01cf 01d3 01df 01e7 01eb 01f3
	01f7 01fd 0209 020b 021d 0223 022d 0233
	0239 023b 0241 024b 0251 0257 0259 025f
	0265 0269 026b 0277 0281 0283 0287 028d
	0293 0295 02a1 02a5 02ab 02b3 02bd 02c5
	02cf 02d7 02dd 02e3 02e7 02ef 02f5 02f9
	0301 0305 0313 031d 0329 032b 0335 0337
	033b 033d 0347 0355 0359 035b 035f 036d
	0371 0373 0377 038b 038f 0397 03a1 03a9
	03ad 03b3 03b9 03c7 03cb 03d1 03d7 03df
	03e5 03f1 03f5 03fb 03fd 0407 0409 040f
	0419 041b 0425 0427 042d 043f 0443 0445
	0449 044f 0455 045d 0463 0469 047f 0481
	048b 0493 049d 04a3 04a9 04b1 04bd 04c1
	04c7 04cd 04cf 04d5 04e1 04eb 04fd 04ff
	0503 0509 050b 0511 0515 0517 051b 0527
	0529 052f 0551 0557 055d 0565 0577 0581
	058f 0593 0595 0599 059f 05a7 05ab 05ad
	05b3 05bf 05c9 05cb 05cf 05d1 05d5 05db
	05e7 05f3 05fb 0607 060d 0611 0617 061f
	0623 062b 062f 063d 0641 0647 0649 064d ]

@queue/buf ( id*, mod*, id*, mod*.. )
	$40

@tote/buf ( length*, length*, length*.. )
	$200 &buf-end

@syms/buf ( dict*, dict*, dict*, dict*.. )
	$200

@label/buf ( addr*, addr*, addr*, addr*.. )
	$200

@dict/buf ( str[], 00, str[], 00.. )
	$400

@world/buf ( id*, count*, id*, count*.. )