Fantastic!
this post was submitted on 28 Mar 2024
4 points (100.0% liked)
Concatenative Programming
145 readers
2 users here now
Hello!
This space is for sharing news, experiences, announcements, questions, showcases, etc. regarding concatenative programming concepts and tools.
We'll also take any programming described as:
- pipelined
- stack-oriented
- tacit
- postfix / reverse Polish notation (RPN)
From Wikipedia:
A concatenative programming language is a point-free computer programming language in which all expressions denote functions, and the juxtaposition of expressions denotes function composition. Concatenative programming replaces function application, which is common in other programming styles, with function composition as the default way to build subroutines.
For example, a sequence of operations in an applicative language like the following:
y = foo(x)
z = bar(y)
w = baz(z)
...is written in a concatenative language as a sequence of functions:
x foo bar baz
Active Languages
Let me know if I've got any of these misplaced!
Primarily Concatenative
Concatenative-ish, Chain-y, Pipe-y, Uniform Function Call Syntax, etc.
- Nim
- Roc
- Unix Pipes
- Cognate
- D Programming Language
- Koka
Cheat Sheets & Tutorials
Discord
IRC
- #concatenative on irc.libera.chat
Wikis
Wikipedia Topics
Subreddits
GitHub Topics
- Stack-Based Language
- Concatenative
- Concatenative Language
- Concatenative Programming Language
- Concatenative Interpreting Language
Blogs
Practice
- Codewars (Forth, Factor, Nim)
- Advent of Code
- Code Golf (Forth, Factor, Nim)
- Project Euler
- Exercism (Nim)
- Perl Weekly Challenge
founded 1 year ago
MODERATORS
Here are a bunch in Factor, taking the easy way when the solution is already in the standard library:
Leap
USING: calendar ;
ALIAS: leap? leap-year?
Reverse String
USING: sequences ;
ALIAS: reverse-string reverse
Raindrops
USING: kernel math.functions math.parser sequences ;
: raindrops ( n -- sound )
{ 3 5 7 } [ dupd divisor? ] map
[ { "Pling" "Plang" "Plong" } nth "" ? ] map-index
concat
[ number>string ] [ nip ] if-empty
;
Roman Numerals
USING: roman ;
ALIAS: roman-numerals >ROMAN
Protein Translation
USING: combinators grouping kernel sequences sequences.extras sets ;
: RNA>proteins ( RNA -- proteins )
3 group
[ { "UAA" "UAG" "UGA" } in? ] cut-when drop
[
{
{ [ dup "AUG" = ] [ "Methionine" ] }
{ [ dup "UGG" = ] [ "Tryptophan" ] }
{ [ dup { "UUU" "UUC" } in? ] [ "Phenylalanine" ] }
{ [ dup { "UUA" "UUG" } in? ] [ "Leucine" ] }
{ [ dup { "UAU" "UAC" } in? ] [ "Tyrosine" ] }
{ [ dup { "UGU" "UGC" } in? ] [ "Cysteine" ] }
{ [ dup { "UCU" "UCC" "UCA" "UCG" } in? ] [ "Serine" ] }
} cond nip
] map
;
Acronym
USING: sequences sequences.extras splitting unicode ;
: >TLA ( phrase -- TLA )
" -" split
[ [ Letter? ] filter ] map-harvest
[ 1 head >upper ] map-concat
;
Allergies
USING: kernel math sequences sets ;
CONSTANT: scores
{ "eggs" "peanuts" "shellfish" "strawberries" "tomatoes" "chocolate" "pollen" "cats" }
: (allergy-test) ( allergens remainder -- allergens' remainder' )
dup log2
[ scores ?nth '[ _ suffix! ] dip ]
[ 2^ - ] bi
;
: allergy-test ( allergen total -- allergic? allergens )
V{ } clone swap
[ (allergy-test) ] until-zero sift
dup [ in? ] dip
;
Raindrops, again
USING: assocs kernel math.functions math.parser sequences sequences.extras ;
: raindrops ( n -- sound )
{ 3 5 7 } [ dupd divisor? ] find-all keys
{ "Pling" "Plang" "Plong" } nths concat
[ number>string ] [ nip ] if-empty ;
Luhn
USING: combinators.short-circuit.smart kernel math math.functions math.parser sequences sequences.extras sets unicode ;
: luhn? ( str -- ? )
" " without
dup { [ length 2 < ] [ [ digit? ] all? not ] } || [ drop f ] [
string>digits
reverse [ <evens> sum ] [ <odds> ] bi
[ 2 * dup 9 > [ 9 - ] when ] map-sum +
10 divisor?
] if
;
Luhn, again
USING: combinators.short-circuit.smart kernel math math.parser rosetta-code.luhn-test sequences sets unicode ;
: ex-luhn? ( str -- ? )
" " without
dup {
[ length 2 < ]
[ [ digit? ] all? not ]
} || [ drop f ] [
string>number luhn?
] if
;
Luhn, a third time
USING: combinators.short-circuit.smart kernel math sequences sets unicode validators ;
: ex-luhn? ( str -- ? )
" " without
dup {
[ length 2 < ]
[ [ digit? ] all? not ]
} || [ drop f ] [ luhn? ] if
;
Scrabble Score
USING: assocs kernel sequences sets unicode ;
MEMO: char>score ( char -- n )
{
{ 1 "AEIOULNRST" } { 2 "DG" }
{ 3 "BCMP" } { 4 "FHVWY" }
{ 5 "K" } { 8 "JX" } { 10 "QZ" }
} [ nip dupd in? ] assoc-find 2drop nip ;
: scrabble-score ( str -- n )
>upper [ char>score ] map-sum ;
Scrabble Score, again
USING: combinators kernel sequences sets unicode ;
MEMO: char>score ( char -- n )
{
{ [ dup "AEIOULNRST" in? ] [ 1 ] }
{ [ dup "DG" in? ] [ 2 ] }
{ [ dup "BCMP" in? ] [ 3 ] }
{ [ dup "FHVWY" in? ] [ 4 ] }
{ [ dup "K" in? ] [ 5 ] }
{ [ dup "JX" in? ] [ 8 ] }
{ [ dup "QZ" in? ] [ 10 ] }
} cond nip ;
: scrabble-score ( str -- n )
>upper [ char>score ] map-sum ;
Scrabble Score, a third time
USING: assocs.extras kernel make sequences unicode ;
: scrabble-score ( str -- n )
>upper
[
"AEIOULNRST" [ 1 swap ,, ] each
"DG" [ 2 swap ,, ] each
"BCMP" [ 3 swap ,, ] each
"FHVWY" [ 4 swap ,, ] each
"K" [ 5 swap ,, ] each
"JX" [ 8 swap ,, ] each
"QZ" [ 10 swap ,, ] each
] H{ } make
swap values-of sum ;
Scrabble Score, 3.5
USING: assocs.extras kernel literals make sequences unicode ;
CONSTANT: charscores $[
[
"AEIOULNRST" [ 1 swap ,, ] each
"DG" [ 2 swap ,, ] each
"BCMP" [ 3 swap ,, ] each
"FHVWY" [ 4 swap ,, ] each
"K" [ 5 swap ,, ] each
"JX" [ 8 swap ,, ] each
"QZ" [ 10 swap ,, ] each
] H{ } make
]
: scrabble-score ( str -- n )
charscores swap >upper values-of sum ;
Scrabble Score 4.0
USING: assocs.extras kernel literals make sequences unicode ;
CONSTANT: charscores $[
[
{ 1 2 3 4 5 8 10 }
{ "AEIOULNRST" "DG" "BCMP" "FHVWY" "K" "JX" "QZ" }
[ [ ,, ] with each ] 2each
] H{ } make
]
: scrabble-score ( str -- n )
charscores swap >upper values-of sum ;
Pangram
USING: sets.extras unicode ;
: pangram? ( str -- ? )
>lower "abcdefghijklmnopqrstuvwxyz" superset? ;
Space Age
USING: assocs calendar math math.extras ;
CONSTANT: year-factors H{
{ "Mercury" 0.2408467 }
{ "Venus" 0.61519726 }
{ "Earth" 1.0 }
{ "Mars" 1.8808158 }
{ "Jupiter" 11.862615 }
{ "Saturn" 29.447498 }
{ "Uranus" 84.016846 }
{ "Neptune" 164.79132 }
}
: space-age ( seconds planet -- earth-years )
year-factors at
years duration>seconds
/
2 round-to-decimal ;
Difference of Squares
USING: kernel math math.statistics ranges sequences ;
: difference-of-squares ( n -- n' )
[1..b] [ sum sq ] [ sum-of-squares ] bi - abs ;