A dialecting/DSL sample in Rebol

euler1_dialect.r

REBOL [ 
  Title:  "Euler1 dialecting example"
  Author: "Torbjørn Marø"
  Home:   http://blog.kjempekjekt.com
  Date:   19-Dec-2011

  Purpose: {
    This script demonstrates how to use the built in parse
    functionality of Rebol to create an internal DSL.
    This particular DSL lets you create sums that are the
    result of adding og subtracting multiples of any number
    below a certain limit.
  }
]


fold: func [
  { Generic high-order function that folds elements of a list.
    Example: fold func[acc x][acc * x] [1 2 3 4]
             evaluates to 24 }
  f [function!] "The folding function"
  l [block!]    "The elements to fold"
  /local acc
] [
  acc: first l ; Start with first element, loop over rest
  foreach x next l [ acc: f acc x ]
]


summing-dialect: context [
  {
    summing-dialect is an object used purely for encapsulation
  }
  use [result operation multiplier below] [

    {
      The SUMMING word is set in the global context as a 
      function that takes a block of instructions as an
      argument and returns the resulting sum.
    }
    set 'summing func [instructions] [
      result: 0
      parse compose instructions [any summing-rules]
      return result
    ]

    {
      The parsing rules. These are the MAIN PART you have to
      grok in order to use parsing and dialects in Rebol.
    }
    summing-rules: [
      set operation [ 'Add | 'Subtract ]
      'multiples 
      'of 
      set multiplier integer!
      'below 
      set below integer!
      (do-instruction) ; called when instruction has been parsed
    ]

    {
      Uses the result of parsing an instruction to create
      the multiples and modify the result
    }
    do-instruction: has [temp] [
      temp: copy [] ; block to contain the multiples
      for x multiplier below - 1 multiplier [ 
        append temp x 
      ]
      ; Sum all the multiples into temp..
      temp: fold func[acc x][ acc + x ] temp
      ; Finally, either add or subtract to/from result 
      result: either operation = 'Add [ 
        result + temp 
      ] [
        result - temp
      ]
    ]
  ]
]

  {
    Then it's time to use the dialect
  }

alert to-string summing []
; >> displays 0

alert to-string summing [ Add multiples of 5 below 11 ]
; >> displays 15

alert to-string summing [ Subtract multiples of 1 below 10 ]
; >> displays -45

; Display the sum of all multiples of 3 or 5 below 1000
alert to-string
  summing [
    Add multiples of 3 below 1000
    Add multiples of 5 below 1000
    ; Since some numbers will have been added twice,
    ; we now have to subtract those numbers once..    
    Subtract multiples of (3 * 5) below 1000
  ]