zeroflag/equinox: Forth Programming Language on Lua
Forth Programming Language on Lua. Contribute to zeroflag/equinox development by creating an account on GitHub.
![GitHub - zeroflag/equinox: Forth Programming Language on Lua](https://lemmy.world/pictrs/image/e7085a4c-1e08-4611-ab95-764481249200.png?format=webp&thumbnail=256)
Discussion on lobsters:
https://lobste.rs/s/2rkupg/intensional_joy_concatenative_account
hex programming language
A tiny, minimalist, concatenative, slightly-esoteric programming language
BUND: concatenative language interpreter and shell
Contribute to vulogov/Bund development by creating an account on GitHub.
![GitHub - vulogov/Bund](https://programming.dev/pictrs/image/1cd76b55-3ff5-49ae-951c-1894d8f76d97.png?format=webp&thumbnail=256)
BlagojeBlagojevic/blang: Fort like lang
Fort like lang. Contribute to BlagojeBlagojevic/blang development by creating an account on GitHub.
![GitHub - BlagojeBlagojevic/blang: Fort like lang](https://programming.dev/pictrs/image/6e319ad3-9ebc-4351-b690-712545c03b18.png?format=webp&thumbnail=256)
We're starting with a new release approach, these files will stay available permanently in contrast to the latest nightly. We now recommend most users to stick to 0.0.0-alpha releases instead of ni...
![Release 0.0.0-alpha1 · roc-lang/roc](https://programming.dev/pictrs/image/ab4a4759-4c14-41f8-b35c-eb6ff638324f.png?format=webp&thumbnail=256)
Copied from the release notes:
> We're starting with a new release approach, these files will stay available permanently in contrast to the latest nightly.
> We now recommend most users to stick to 0.0.0-alpha releases instead of nightly-latest.
> This current release is based on commit a089cf2 from the 6th of January 2025. These files are identical to nightly-latest published on the 7th of January 2025.
---
EDIT: A whole lot more detail in the new 0.0.0-alpha2-rolling release
It's been a while, but my clumsy adding of a comment to the buffer is unnecessary, given zle -M
, which will display a message outside of the buffer. So here's an updated version:
# -- Run input if single line, otherwise insert newline --
# Key: enter
# Credit: https://programming.dev/comment/2479198
.zle_accept-except-multiline () {
if [[ $BUFFER != *$'\n'* ]] {
zle .accept-line
return
} else {
zle .self-insert-unmeta
zle -M 'Use alt+enter to submit this multiline input'
}
}
zle -N .zle_accept-except-multiline
bindkey '^M' .zle_accept-except-multiline # Enter
# -- Run input if multiline, otherwise insert newline --
# Key: alt+enter
# Credit: https://programming.dev/comment/2479198
.zle_accept-only-multiline () {
if [[ $BUFFER == *$'\n'* ]] {
zle .accept-line
} else {
zle .self-insert-unmeta
}
}
zle -N .zle_accept-only-multiline
bindkey '^[^M' .zle_accept-only-multiline # Enter
The given Uiua example (mercifully given using words rather than the symbols):
[3 4 5 10 23]
divide length on /+
For all the talk about "forward" it's uncomfortable to me how the Uiua evaluation within a line happens backward.
An equivalent in Factor, where keep
is close to on
:
{ 3 4 5 10 23 }
[ sum ] keep length /
But this pattern of doing two things in sequence to the same item is common enough that bi
is handy:
{ 3 4 5 10 23 }
[ sum ] [ length ] bi /
Discussion om lobsters: https://lobste.rs/s/ayiyce/spreadsheets_1_3_rye_language
Day 6
spoiler
: get-input ( -- rows )
"vocab:aoc-2024/06/input.txt" utf8 file-lines ;
: all-locations ( rows -- pairs )
dimension <coordinate-matrix> concat ;
: guard-location ( rows -- pair )
[ all-locations ] keep
'[ _ matrix-nth "<>^v" in? ] find nip ;
TUPLE: state location char ;
C: <state> state
: guard-state ( rows -- state )
[ guard-location ]
[ dupd matrix-nth ] bi <state> ;
: faced-location ( state -- pair )
[ char>> H{
{ CHAR: > { 0 1 } }
{ CHAR: v { 1 0 } }
{ CHAR: < { 0 -1 } }
{ CHAR: ^ { -1 0 } }
} at ] [ location>> ] bi v+ ;
: off-grid? ( rows location -- ? )
[ dimension ] dip
[ v<= vany? ] keep
{ 0 0 } v< vany? or ;
: turn ( state -- state' )
[ location>> ] [ char>> ] bi
H{
{ CHAR: > CHAR: v }
{ CHAR: v CHAR: < }
{ CHAR: < CHAR: ^ }
{ CHAR: ^ CHAR: > }
} at <state> ;
: obstacle? ( rows location -- ? )
swap matrix-nth CHAR: # = ;
: guard-step ( rows state -- state' )
swap over faced-location
{
{ [ 2dup off-grid? ] [ 2nip f <state> ] }
{ [ [ obstacle? ] keep-under ] [ drop turn ] }
[ swap char>> <state> ]
} cond ;
: walk-out ( rows state -- trail )
[
[ 2dup location>> off-grid? ] [
dup location>> ,
dupd guard-step
] until
] { } make 2nip ;
: part1 ( -- n )
get-input dup guard-state walk-out cardinality ;
: (walk-loops?) ( visited rows state -- looped? )
dupd guard-step
2dup location>> off-grid? [ 3drop f ] [
pick dupd in? [ 3drop t ] [
pick dupd adjoin (walk-loops?)
] if
] if ;
: walk-loops? ( rows -- looped? )
dup guard-state
[ HS{ } clone ] 2dip
pick dupd adjoin (walk-loops?) ;
: obstacle-candidates ( rows -- pairs )
[ guard-location ]
[ dup guard-state walk-out members ] bi remove ;
: part2 ( -- n )
get-input dup obstacle-candidates
[ CHAR: # spin deep-clone [ matrix-set-nth ] keep walk-loops? ] with count ;
Slow and dumb gets it done! I may revisit this when I give up on future days.
Factor
spoiler
TUPLE: equation value numbers ;
C: <equation> equation
: get-input ( -- equations )
"vocab:aoc-2024/07/input.txt" utf8 file-lines [
split-words unclip but-last string>number
swap [ string>number ] map <equation>
] map ;
: possible-quotations ( funcs numbers -- quots )
dup length 1 -
swapd all-selections
[ unclip swap ] dip
[ zip concat ] with map
swap '[ _ prefix >quotation ] map ;
: possibly-true? ( funcs equation -- ? )
[ numbers>> possible-quotations ] [ value>> ] bi
'[ call( -- n ) _ = ] any? ;
: solve ( funcs -- n )
get-input
[ possibly-true? ] with filter
[ value>> ] map-sum ;
: part1 ( -- n )
{ + * } solve ;
: _|| ( m n -- mn )
[ number>string ] bi@ append string>number ;
: part2 ( -- n )
{ + * _|| } solve ;
Nothing smart to see here. I may revisit this when I give up on future days.
Factor
spoiler
: get-input ( -- rows )
"vocab:aoc-2024/06/input.txt" utf8 file-lines ;
: all-locations ( rows -- pairs )
dimension <coordinate-matrix> concat ;
: guard-location ( rows -- pair )
[ all-locations ] keep
'[ _ matrix-nth "<>^v" in? ] find nip ;
TUPLE: state location char ;
C: <state> state
: guard-state ( rows -- state )
[ guard-location ]
[ dupd matrix-nth ] bi <state> ;
: faced-location ( state -- pair )
[ char>> H{
{ CHAR: > { 0 1 } }
{ CHAR: v { 1 0 } }
{ CHAR: < { 0 -1 } }
{ CHAR: ^ { -1 0 } }
} at ] [ location>> ] bi v+ ;
: off-grid? ( rows location -- ? )
[ dimension ] dip
[ v<= vany? ] keep
{ 0 0 } v< vany? or ;
: turn ( state -- state' )
[ location>> ] [ char>> ] bi
H{
{ CHAR: > CHAR: v }
{ CHAR: v CHAR: < }
{ CHAR: < CHAR: ^ }
{ CHAR: ^ CHAR: > }
} at <state> ;
: obstacle? ( rows location -- ? )
swap matrix-nth CHAR: # = ;
: guard-step ( rows state -- state' )
swap over faced-location
{
{ [ 2dup off-grid? ] [ 2nip f <state> ] }
{ [ [ obstacle? ] keep-under ] [ drop turn ] }
[ swap char>> <state> ]
} cond ;
: walk-out ( rows state -- trail )
[
[ 2dup location>> off-grid? ] [
dup location>> ,
dupd guard-step
] until
] { } make 2nip ;
: part1 ( -- n )
get-input dup guard-state walk-out cardinality ;
: (walk-loops?) ( visited rows state -- looped? )
dupd guard-step
2dup location>> off-grid? [ 3drop f ] [
pick dupd in? [ 3drop t ] [
pick dupd adjoin (walk-loops?)
] if
] if ;
: walk-loops? ( rows -- looped? )
dup guard-state
[ HS{ } clone ] 2dip
pick dupd adjoin (walk-loops?) ;
: obstacle-candidates ( rows -- pairs )
[ guard-location ]
[ dup guard-state walk-out members ] bi remove ;
: part2 ( -- n )
get-input dup obstacle-candidates
[ CHAR: # spin deep-clone [ matrix-set-nth ] keep walk-loops? ] with count ;
Day 5
spoiler
: get-input ( -- rules updates )
"vocab:aoc-2024/05/input.txt" utf8 file-lines
{ "" } split1
"|" "," [ '[ [ _ split ] map ] ] bi@ bi* ;
: relevant-rules ( rules update -- rules' )
'[ [ _ in? ] all? ] filter ;
: compliant? ( rules update -- ? )
[ relevant-rules ] keep-under
[ [ index* ] with map first2 < ] with all? ;
: middle-number ( update -- n )
dup length 2 /i nth-of string>number ;
: part1 ( -- n )
get-input
[ compliant? ] with
[ middle-number ] filter-map sum ;
: compare-pages ( rules page1 page2 -- <=> )
[ 2array relevant-rules ] keep-under
[ drop +eq+ ] [ first index zero? +gt+ +lt+ ? ] if-empty ;
: correct-update ( rules update -- update' )
[ swapd compare-pages ] with sort-with ;
: part2 ( -- n )
get-input dupd
[ compliant? ] with reject
[ correct-update middle-number ] with map-sum ;
Factor
: get-input ( -- rules updates )
"vocab:aoc-2024/05/input.txt" utf8 file-lines
{ "" } split1
"|" "," [ '[ [ _ split ] map ] ] bi@ bi* ;
: relevant-rules ( rules update -- rules' )
'[ [ _ in? ] all? ] filter ;
: compliant? ( rules update -- ? )
[ relevant-rules ] keep-under
[ [ index* ] with map first2 < ] with all? ;
: middle-number ( update -- n )
dup length 2 /i nth-of string>number ;
: part1 ( -- n )
get-input
[ compliant? ] with
[ middle-number ] filter-map sum ;
: compare-pages ( rules page1 page2 -- <=> )
[ 2array relevant-rules ] keep-under
[ drop +eq+ ] [ first index zero? +gt+ +lt+ ? ] if-empty ;
: correct-update ( rules update -- update' )
[ swapd compare-pages ] with sort-with ;
: part2 ( -- n )
get-input dupd
[ compliant? ] with reject
[ correct-update middle-number ] with map-sum ;
Factor
spoiler
: get-input ( -- rows )
"vocab:aoc-2024/04/input.txt" utf8 file-lines ;
: verticals ( rows -- lines )
[ dimension last [0..b) ] keep cols ;
: slash-origins ( rows -- coords )
dimension
[ first [0..b) [ 0 2array ] map ] [
first2 [ 1 - ] [ 1 (a..b] ] bi*
[ 2array ] with map
] bi append ;
: backslash-origins ( rows -- coords )
dimension first2
[ [0..b) [ 0 2array ] map ]
[ 1 (a..b] [ 0 swap 2array ] map ] bi* append ;
: slash ( rows origin -- line )
first2
[ 0 [a..b] ]
[ pick dimension last [a..b) ] bi* zip
swap matrix-nths ;
: backslash ( rows origin -- line )
[ dup dimension ] dip first2
[ over first [a..b) ]
[ pick last [a..b) ] bi* zip nip
swap matrix-nths ;
: slashes ( rows -- lines )
dup slash-origins
[ slash ] with map ;
: backslashes ( rows -- lines )
dup backslash-origins
[ backslash ] with map ;
: word-count ( line word -- n )
dupd [ reverse ] dip
'[ _ subseq-indices length ] bi@ + ;
: part1 ( -- n )
get-input
{ [ ] [ verticals ] [ slashes ] [ backslashes ] } cleave-array concat
[ "XMAS" word-count ] map-sum ;
: origin-adistances ( rows origins line-quot: ( rows origin -- line ) -- origin-adistances-assoc )
with zip-with
"MAS" "SAM" [ '[ [ _ subseq-indices ] map-values ] ] bi@ bi append
harvest-values
[ [ 1 + ] map ] map-values ; inline
: a-coords ( origin-adistances coord-quot: ( adistance -- row-delta col-delta ) -- coords )
'[ first2 [ @ 2array v+ ] with map ] map-concat ; inline
: slash-a-coords ( rows -- coords )
dup slash-origins [ slash ] origin-adistances
[ [ 0 swap - ] keep ] a-coords ;
: backslash-a-coords ( rows -- coords )
dup backslash-origins [ backslash ] origin-adistances
[ dup ] a-coords ;
: part2 ( -- n )
get-input [ slash-a-coords ] [ backslash-a-coords ] bi
intersect length ;
Better viewed on GitHub.
Day 4
spoiler
: get-input ( -- rows )
"vocab:aoc-2024/04/input.txt" utf8 file-lines ;
: verticals ( rows -- lines )
[ dimension last [0..b) ] keep cols ;
: slash-origins ( rows -- coords )
dimension
[ first [0..b) [ 0 2array ] map ] [
first2 [ 1 - ] [ 1 (a..b] ] bi*
[ 2array ] with map
] bi append ;
: backslash-origins ( rows -- coords )
dimension first2
[ [0..b) [ 0 2array ] map ]
[ 1 (a..b] [ 0 swap 2array ] map ] bi* append ;
: slash ( rows origin -- line )
first2
[ 0 [a..b] ]
[ pick dimension last [a..b) ] bi* zip
swap matrix-nths ;
: backslash ( rows origin -- line )
[ dup dimension ] dip first2
[ over first [a..b) ]
[ pick last [a..b) ] bi* zip nip
swap matrix-nths ;
: slashes ( rows -- lines )
dup slash-origins
[ slash ] with map ;
: backslashes ( rows -- lines )
dup backslash-origins
[ backslash ] with map ;
: word-count ( line word -- n )
dupd [ reverse ] dip
'[ _ subseq-indices length ] bi@ + ;
: part1 ( -- n )
get-input
{ [ ] [ verticals ] [ slashes ] [ backslashes ] } cleave-array concat
[ "XMAS" word-count ] map-sum ;
: origin-adistances ( rows origins line-quot: ( rows origin -- line ) -- origin-adistances-assoc )
with zip-with
"MAS" "SAM" [ '[ [ _ subseq-indices ] map-values ] ] bi@ bi append
harvest-values
[ [ 1 + ] map ] map-values ; inline
: a-coords ( origin-adistances coord-quot: ( adistance -- row-delta col-delta ) -- coords )
'[ first2 [ @ 2array v+ ] with map ] map-concat ; inline
: slash-a-coords ( rows -- coords )
dup slash-origins [ slash ] origin-adistances
[ [ 0 swap - ] keep ] a-coords ;
: backslash-a-coords ( rows -- coords )
dup backslash-origins [ backslash ] origin-adistances
[ dup ] a-coords ;
: part2 ( -- n )
get-input [ slash-a-coords ] [ backslash-a-coords ] bi
intersect length ;
Better viewed on GitHub
More Factor solutions for the first 3 days (at time of comment) from okflo, on sourcehut.
Some more Factor solutions for the first 3 days (so far) from soweli Niko, on Codeberg.
Factor
: get-input ( -- corrupted-input )
"vocab:aoc-2024/03/input.txt" utf8 file-contents ;
: get-muls ( corrupted-input -- instructions )
R/ mul\(\d+,\d+\)/ all-matching-subseqs ;
: process-mul ( instruction -- n )
R/ \d+/ all-matching-subseqs
[ string>number ] map-product ;
: solve ( corrupted-input -- n )
get-muls [ process-mul ] map-sum ;
: part1 ( -- n )
get-input solve ;
: part2 ( -- n )
get-input
R/ don't\(\)(.|\n)*?do\(\)/ split concat
R/ don't\(\)(.|\n)*/ "" re-replace
solve ;
Factor
: get-input ( -- reports )
"vocab:aoc-2024/02/input.txt" utf8 file-lines
[ split-words [ string>number ] map ] map ;
: slanted? ( report -- ? )
{ [ [ > ] monotonic? ] [ [ < ] monotonic? ] } || ;
: gradual? ( report -- ? )
[ - abs 1 3 between? ] monotonic? ;
: safe? ( report -- ? )
{ [ slanted? ] [ gradual? ] } && ;
: part1 ( -- n )
get-input [ safe? ] count ;
: fuzzy-reports ( report -- reports )
dup length <iota> [ remove-nth-of ] with map ;
: tolerable? ( report -- ? )
{ [ safe? ] [ fuzzy-reports [ safe? ] any? ] } || ;
: part2 ( -- n )
get-input [ tolerable? ] count ;
Factor
: get-input ( -- left-list right-list )
"vocab:aoc-2024/01/input.txt" utf8 file-lines
[ split-words harvest ] map unzip
[ [ string>number ] map ] bi@ ;
: part1 ( -- n )
get-input
[ sort ] bi@
[ - abs ] 2map-sum ;
: part2 ( -- n )
get-input
histogram
'[ dup _ at 0 or * ] map-sum ;
Factor!
Day 3
spoiler
: get-input ( -- corrupted-input )
"aoc-2024.03" "input.txt" vocab-file-path utf8 file-contents ;
: get-muls ( corrupted-input -- instructions )
R/ mul\(\d+,\d+\)/ all-matching-subseqs ;
: process-mul ( instruction -- n )
R/ \d+/ all-matching-subseqs
[ string>number ] map-product ;
: solve ( corrupted-input -- n )
get-muls [ process-mul ] map-sum ;
: part1 ( -- n )
get-input solve ;
: part2 ( -- n )
get-input
R/ don't\(\)(.|\n)*?do\(\)/ split concat
R/ don't\(\)(.|\n)*/ "" re-replace
solve ;
Image:
spoiler
Day 2:
spoiler
: get-input ( -- reports )
"aoc-2024.02" "input.txt" vocab-file-lines
[ split-words [ string>number ] map ] map ;
: slanted? ( report -- ? )
{ [ [ > ] monotonic? ] [ [ < ] monotonic? ] } || ;
: gradual? ( report -- ? )
[ - abs 1 3 between? ] monotonic? ;
: safe? ( report -- ? )
{ [ slanted? ] [ gradual? ] } && ;
: part1 ( -- n )
get-input [ safe? ] count ;
: fuzzy-reports ( report -- reports )
dup length <iota> [ remove-nth-of ] with map ;
: tolerable? ( report -- ? )
{ [ safe? ] [ fuzzy-reports [ safe? ] any? ] } || ;
: part2 ( -- n )
get-input [ tolerable? ] count ;
Image:
spoiler
Happy Advent of Code 2024 Everyone!
Alright, show me I'm not the only one in this community, and show off some solutions!
Here's my Day 1 solution in Factor (minus imports):
spoiler
``` : get-input ( -- left-list right-list ) "aoc-2024.01" "input.txt" vocab-file-lines [ split-words harvest ] map unzip [ [ string>number ] map ] bi@ ;
: part1 ( -- n ) get-input [ sort ] bi@ [ - abs ] 2map-sum ;
: part2 ( -- n ) get-input histogram '[ dup _ at 0 or * ] map-sum ; ```
Sadly, Factor doesn't get highlighted properly here, so here it is again as an image:
I probably won't last the week, but what solutions I do have will be up on GitHub.
This example is my justification for posting it here:
haskell "NeoHaskell is cool" |> Text.toWordList |> List.map Text.length |> List.map (\x -> x * x) |> List.takeIf Int.isEven
A lot of Forth discussion in the HN comments:
To celebrate ChipWits' 40th Anniversary, the original FORTH source code has been open sourced! Learn about the game's history and source code
![ChipWits' 40th Birthday: Original FORTH Code Open Sourced! - ChipWits Robot Coding Game](https://programming.dev/pictrs/image/115fec99-8fda-4a06-87f0-aeffb39cd254.png?format=webp&thumbnail=256)
Changelog ea87548 Add the "dup" operator. 8231403 Improve precision handling a bit. a6148e8 Update README.md with decimal and brew info. 6184a22 Updated CHANGELOG.md to v1.0.0.
![Release v1.0.0 · marcopaganini/rpn](https://programming.dev/pictrs/image/23e13767-b809-4aa1-82f0-7cac9df21b75.png?format=webp&thumbnail=256)
I posted this project here before, but it's now reached 1.0.0.