( hey kirie! )

|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
|a0 @File/vector $2 &success $1 &success-lb $1 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2

|000

	@token/buf $40
	@lhs/buf $20
	@rhs/buf $20
	@live/buf $40

|100

@on-reset ( -> )
	;meta #06 DEO2
	;token/on-console .Console/vector DEO2
	BRK

@meta $1
	( name ) "Neur 0a
	( desc ) "Neural 20 "Nets 20 "Language 0a
	( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a
	( date ) "31 20 "May 20 "2025 $2

@token/on-console ( -> )
	.Console/read DEI
	( ) DUP #21 LTH ?/<clear>
	( ) DUP [ LIT "* ] EQU ?/neur
	( ) DUP [ LIT ": ] EQU ?/exci
	( ) DUP [ LIT "; ] EQU ?/inhi
	( ) DUP [ LIT ". ] EQU ?/done
	[ LIT2 00 &ptr -&buf ] INCk ,&ptr STR
	STZ2
	BRK

@token/neur ( c -> )
	;&buf mind/find-alloc rule/<push-neuron> !/<clear>

@token/exci ( c -> )
	;Neuron/exci-list rule/<bind-type> !/<clear>

@token/inhi ( c -> )
	;Neuron/inhi-list rule/<bind-type> !/<clear>

@token/done ( c -> )
	rule/<bind-auto>
	rule/<init>
	( >> )

@token/<clear> ( c -> )
	[ LIT2 -&buf _&ptr ] STR
	[ LIT2 00 -&buf ] STZ
	POP BRK

(
@|list )

%list/new ( -- cell* ) {
	#ffff }

%list/cdr ( cell* -- cell* ) {
	INC2 INC2 LDA2 }

%list/car ( cell* -- value* ) {
	LDA2 }

@list/<each> ( cell* func* -- )
	STH2
	INC2k ORA ?{ POP2 POP2r JMP2r }
	( * ) STH2kr JSR2 list/cdr STH2r !/<each>

@list/<cons> ( value* list* -- head* )
	( cdr* ) [ LIT2 &ptr =&buf ] STH2k STA2
	( car* ) INC2kr INC2r STH2kr STA2
	( ptr* ) INC2r INC2r [ LITr _&ptr ] STR2r
	STH2r JMP2r

(
@|Compiler )

@rule/<init> ( -- )
	[ LIT2 00 _&depth ] STR
	[ LIT2 00 _&dst ] STR
	lhs/<init> !rhs/<init>

@rule/<push-connection> ( b* a* -- )
	[ LIT2 &dst =Neuron/exci-list ] ADD2 STH2k LDA2 SWP2 list/<cons>
	STH2r STA2
	JMP2r

@rule/<bind-type> ( dst* -- )
	,&dst STR2
	/<bind>
	,&depth LDR INC ,&depth STR
	JMP2r

@rule/is-odd ( -- even/odd )
	[ LIT2 01 &depth $1 ] AND JMP2r

@rule/<bind-auto> ( -- )
	,&depth LDR ?{ lhs/get-range ;neuron/do-wake arr2/<foreach> !live/<eval> }
	( >> )

@rule/<bind> ( -- )
	/get-from-range
	( | get infer threshold )
	SUB2k #01 SFT2 EQUk ?{ DUP ,&threshold STR }
	POP2
	( | connect each )
	;/do-connect arr2/<foreach>
	/is-odd ?lhs/<init>
	!rhs/<init>

@rule/do-connect ( n* -- n* )
	LDA2k STH2
	/get-to-range
	&>lb
		EQU2k ?{
			( | set infer threshold )
			LDA2k neuron/get-state .State/alive AND ?{
				LDA2k [ LIT2 -State/alive &threshold $1 ]
				( set ) SWP2 neuron/<set-state-threshold> }
			( | bind )
			LDA2k STH2kr /<push-connection>
			INC2 INC2 !&>lb }
	POP2 POP2 POP2r JMP2r

@rule/<push-neuron> ( n* -- )
	/is-odd ?rhs/<push-neuron>
	!lhs/<push-neuron>

@rule/get-from-range ( -- to* from* )
	/is-odd ?lhs/get-range
	!rhs/get-range

@rule/get-to-range ( -- to* from* )
	/is-odd ?rhs/get-range
	!lhs/get-range

@lhs/<init> ( -- )
	[ LIT2 -&buf _&ptr ] STR
	JMP2r

@lhs/get-range ( -- to* from* )
	[ LIT2 00 _&ptr ] LDR ;&buf JMP2r

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

@rhs/<init> ( -- )
	[ LIT2 -&buf _&ptr ] STR
	JMP2r

@rhs/get-range ( -- to* from* )
	[ LIT2 00 _&ptr ] LDR ;&buf JMP2r

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

(
@|Runtime )

@live/<push-neuron> ( n* -- )
	STH2
	( | find neuron )
	,&ptr LDR .&buf
	&>lf
		EQUk ?{
			LDZ2k STH2kr NEQ2 ?{ POP2 POP2r JMP2r }
			INC INC !&>lf }
	POP2 STH2r
	( | push neuron )
	[ LIT &ptr -&buf ] INCk INC ,&ptr STR
	STZ2
	JMP2r

@live/<eval> ( -- )
	mind/<fire>
	[ LIT2 00 _&limit ] STR
	&>w
		,&ptr LDR .&buf EQU ?{
			[ LIT2 80 &limit $1 ] INCk ,&limit STR
			/<step>
			NEQ ?&>w }
	JMP2r

@live/<step> ( -- )
	excited/<init>
	dirty/<init>
	[ LIT2 00 _&ptr ] LDR ;&buf ;neuron/do-step arr2/<foreach>
	#0a19 DEO
	[ LIT2 -&buf _&ptr ] STR
	excited/<preserve> !dirty/<clean>

@excited/<init> ( -- )
	;&buf ,&ptr STR2
	JMP2r

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

@excited/<preserve> ( -- )
	,&ptr LDR2 ;&buf ;/do-preserve !arr2/<foreach>

@excited/do-preserve ( n* -- n* )
	LDA2k neuron/get-state .State/inhibited AND ?{
		( live ) LDA2k !live/<push-neuron> }
	JMP2r

@dirty/<init> ( -- )
	;&buf ,&ptr STR2
	JMP2r

@dirty/<push-neuron> ( n* -- n* )
	DUP2 [ LIT2 &ptr =&buf ] INC2k INC2 ,&ptr STR2
	STA2
	JMP2r

@dirty/<clean> ( -- )
	,&ptr LDR2 ;&buf ;/do-clean !arr2/<foreach>

@dirty/do-clean ( n* -- n* )
	LDA2k STH2
	.State/alive STH2kr neuron/<set-state>
	#00 STH2r !neuron/<set-saturation>

(
@|Neuron )

@neuron/<print-name> ( neuron* -- )
	LDA2k str/<print>
	[ LIT2 "/ 19 ] DEO
	/get-threshold #0f AND [ LIT "0 ] ADD #19 DEO
	#2019 DEO
	JMP2r

@neuron/do-wake ( n* -- n* )
	LDA2k [ LIT2 -State/alive-fire 01 ] SWP2 !neuron/<set-state-threshold>

@neuron/do-step ( n* -- n* )
	LDA2k DUP2 /<print-name>
	DUP2 /get-threshold ?{
		( /0 always excited ) DUP2 excited/<push-neuron> }
	DUP2 ;Neuron/inhi-list ADD2 LDA2 ;/do-send-inhi list/<each>
	;Neuron/exci-list ADD2 LDA2 ;/do-send-exci !list/<each>

@neuron/do-send-exci ( n* -- n* )
	LDA2k dirty/<push-neuron>
	DUP2 neuron/<inc-saturation>
	?{ DUP2 excited/<push-neuron> }
	POP2 JMP2r

@neuron/do-send-inhi ( n* -- n* )
	LDA2k dirty/<push-neuron>
	.State/alive-inhibited ROT ROT
	( >> )

@neuron/<set-state> ( state n* -- )
	;Neuron/state ADD2 STA
	JMP2r

@neuron/get-state ( n* -- state )
	;Neuron/state ADD2 LDA JMP2r

@neuron/<inc-saturation> ( n* -- saturated )
	;Neuron/threshold ADD2 LDA2k INC OVR2 STA2
	LDA2 GTH JMP2r

@neuron/<set-saturation> ( sat n* -- )
	;Neuron/saturation ADD2 STA
	JMP2r

@neuron/<set-manual-threshold> ( /0* n* -- )
	STH2
	SWP [ LIT "/ ] EQU ?{
		POP #01 STH2r ;Neuron/threshold ADD2 STA
		JMP2r }
	[ LIT "0 ] SUB .State/alive SWP STH2r
	( >> )

@neuron/<set-state-threshold> ( state threshold n* -- )
	;Neuron/state ADD2 STA2
	JMP2r

@neuron/get-threshold ( n* -- threshold )
	;Neuron/threshold ADD2 LDA JMP2r

(
@|Storage )

@mind/find-alloc ( name* -- neuron* )
	LDZk ?{ POP2 ;anon-name !/<push-name> }
	( | find neuron )
	STH2
	,&ptr LDR2 ;&buf
	&>lf
		EQU2k ?{
			LDA2k STH2kr SWP2 str/compare ?{ POP2r NIP2 JMP2r }
			;Neuron/size ADD2 !&>lf }
	POP2 POP2
	( | allocate neuron )
	STH2r dict/push-word
	( | set threshold )
	LDA2 ,&ptr LDR2 neuron/<set-manual-threshold>
	( >> )

@mind/<push-name> ( name* -- neuron* )
	( | set empty lists )
	list/new ,&ptr LDR2 ;Neuron/exci-list ADD2 STA2
	list/new ,&ptr LDR2 ;Neuron/inhi-list ADD2 STA2
	[ LIT2 &ptr =&buf ] DUP2 ;Neuron/size ADD2 ,&ptr STR2
	STA2k NIP2 JMP2r

@mind/<fire> ( -- )
	,&ptr LDR2 ;&buf
	&>lk
		EQU2k ?{
			DUP2 ;Neuron/state ADD2 LDA2
			( not zero ) #00 NEQ SWP
			( not fire ) .State/alive-fire NEQ AND ?{
				( push ) DUP2 live/<push-neuron> }
			;Neuron/size ADD2 !&>lk }
	POP2 POP2 JMP2r

@dict/push-word ( str* -- ptr* cap* )
	,&ptr LDR2 SWP2
	&>w
		LDAk [ LIT "* ] EQU ?&end
		LDAk [ LIT "/ ] EQU ?&end
		LDAk /<push-byte>
		INC2 LDAk ?&>w
	&end ( -- )
	#00
	( >> )

@dict/<push-byte> ( c -- )
	[ LIT2 &ptr =&buf ] INC2k ,&ptr STR2
	STA
	JMP2r

(
@|etc )

@str/compare ( s* n* -- false )
	STH2
	&>w
		LDAk LDAkr STHr NEQ ?{ INC2 INC2r LDAk ?&>w }
	LDA LDAr STHr ?{
		( ) DUP #00 NEQ
		( ) SWP [ LIT "/ ] NEQ AND JMP2r }
	POP #01 JMP2r

@str/<print> ( str* -- )
	LDAk #19 DEO
	INC2 LDAk ?/<print>
	POP2 JMP2r

@arr2/<foreach> ( to* from* fn* -- )
	STH2
	&>l
		EQU2k ?{
			STH2kr JSR2 INC2 INC2 !&>l }
	POP2 POP2 POP2r JMP2r

@<phex> ( short* -: )
	SWP /b
	&b ( byte -: )
	DUP #04 SFT /c
	&c ( byte -: )
	#0f AND DUP #09 GTH #27 MUL ADD [ LIT "0 ] ADD #18 DEO
	JMP2r

(
@|assets )

@anon-name "* $1

@excited/buf $40

@dirty/buf $40

@dict/buf $4000

@list/buf ( [car* cdr*] )
	$400

@mind/buf $4000

(
@|State
	| State Bits: 0 . 0 . 0 . 0 . 0 . fire . inhibited . alive )

|00 @Neuron/name $2 &state $1 &threshold $1 &saturation $1
	( lists ) &exci-list $2 &inhi-list $2 &size
|01 @State/alive
|02 @State/inhibited
|03 @State/alive-inhibited
|05 @State/alive-fire