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:

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.

Cheat Sheets & Tutorials

Discord

IRC

Wikis

Wikipedia Topics

Subreddits

GitHub Topics

Blogs

Practice

founded 1 year ago
MODERATORS
[email protected]
[email protected]
4
Show off your solutions to Exercism's 48in24, but in your favorite stacky lang! (exercism.org)
submitted 7 months ago by [email protected] to c/[email protected]
13 comments fedilink hide all child comments
 

Just because Exercism doesn't offer your favorite language as an official track, it doesn't mean we can't play at all. Post some solutions to the weekly challenges in the language of your choice!

top 13 comments
sorted by: hot top controversial new old
[–] [email protected] 2 points 7 months ago (1 children)

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
;

[–] [email protected] 1 points 7 months ago

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 ;

[–] [email protected] 2 points 7 months ago

Fantastic!

[–] [email protected] 1 points 6 months ago

Pangram

USING: sets.extras unicode ;

: pangram? ( str -- ? )
  >lower "abcdefghijklmnopqrstuvwxyz" superset? ;

[–] [email protected] 1 points 7 months ago* (last edited 7 months ago) (1 children)

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 ;

[–] [email protected] 1 points 7 months ago (1 children)

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 ;

[–] [email protected] 1 points 7 months ago (1 children)

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 ;

[–] [email protected] 1 points 7 months ago (1 children)

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 ;

[–] [email protected] 1 points 6 months ago

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 ;

[–] [email protected] 1 points 7 months ago

Difference of Squares

USING: kernel math math.statistics ranges sequences ;

: difference-of-squares ( n -- n' )
  [1..b] [ sum sq ] [ sum-of-squares ] bi - abs ;

[–] [email protected] 1 points 5 months ago* (last edited 5 months ago)

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 ;

[–] [email protected] 1 points 7 months ago (1 children)

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
;

[–] [email protected] 1 points 7 months ago

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
;