T Rule
   String pattern
   String replacement
   Bool terminating
   F (pattern, replacement, terminating)
      .pattern = pattern
      .replacement = replacement
      .terminating = terminating

F parse(rules)
   [Rule] result
   L(line) rules.split("\n")
      I line.starts_with(‘#’)
         L.continue
      I line.trim(‘ ’).empty
         L.continue

      V (pat, rep) = line.split(‘ -> ’)

      V terminating = 0B
      I rep.starts_with(‘.’)
         rep = rep[1..]
         terminating = 1B

      result.append(Rule(pat, rep, terminating))
   R result

F apply(text, rules)
   V result = text
   V changed = 1B

   L changed == 1B
      changed = 0B
      L(rule) rules
         I rule.pattern C result
            result = result.replace(rule.pattern, rule.replacement)
            I rule.terminating
               R result
            changed = 1B
            L.break

   R result

V SampleTexts = [‘I bought a B of As from T S.’,
                 ‘I bought a B of As from T S.’,
                 ‘I bought a B of As W my Bgage from T S.’,
                 ‘_1111*11111_’,
                 ‘000000A000000’]

V RuleSets = [
‘# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
A -> apple
B -> bag
S -> shop
T -> the
the shop -> my brother
a never used -> .terminating rule’,

‘# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule’,

‘# BNF Syntax testing rules
A -> apple
WWWW -> with
Bgage -> ->.*
B -> bag
->.* -> money
W -> WW
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule’,

‘### Unary Multiplication Engine, for testing Markov Algorithm implementations
### By Donal Fellows.
# Unary addition engine
_+1 -> _1+
1+1 -> 11+
# Pass for converting from the splitting of multiplication into ordinary
# addition
1! -> !1
,! -> !+
_! -> _
# Unary multiplication by duplicating left side, right side times
1*1 -> x,@y
1x -> xX
X, -> 1,1
X1 -> 1X
_x -> _X
,x -> ,X
y1 -> 1y
y_ -> _
# Next phase of applying
[email protected] -> x,@y
[email protected]_ -> @_
,@_ -> !_
++ -> +
# Termination cleanup for addition
_1 -> 1
1+_ -> 1
_+_ -> ’,

‘# Turing machine: three-state busy beaver
#
# state A, symbol 0 => write 1, move right, new state B
A0 -> 1B
# state A, symbol 1 => write 1, move left, new state C
0A1 -> C01
1A1 -> C11
# state B, symbol 0 => write 1, move left, new state A
0B0 -> A01
1B0 -> A11
# state B, symbol 1 => write 1, move right, new state B
B1 -> 1B
# state C, symbol 0 => write 1, move left, new state B
0C0 -> B01
1C0 -> B11
# state C, symbol 1 => write 1, move left, halt
0C1 -> H01
1C1 -> H11’]

L(ruleset) RuleSets
   V rules = parse(ruleset)
   print(apply(SampleTexts[L.index], rules))


FIBON:
REM Fibonacci sequence is generated to the Organiser II floating point variable limit.
REM CLEAR/ON key quits.
REM Mikesan - http://forum.psion2.org/
LOCAL A,B,C
A=1 :B=1 :C=1
PRINT A,
DO
  C=A+B
  A=B
  B=C
  PRINT A,
UNTIL GET=1


n = argument0
j = 1
for(i = 1; i <= n; i += 1)
    j *= i
return j


set xrange [0:4.95]
set key left
plot int(x)!


[email protected](SceneElement traits) doWithRestart: block
[
  block handlingCases: {Abort -> [| :_ | ^ Nil]}
].


"exec" "gst" "-f" "$0" "$0" "$*"
"exit"

Transcript show: 'Throwing yawp'; cr.
self error: 'Yawp!'.


--#SET TERMINATOR @

BEGIN
 DECLARE numerator INTEGER DEFAULT 12;
 DECLARE denominator INTEGER DEFAULT 0;
 DECLARE RESULT INTEGER;
 DECLARE overflow CONDITION FOR SQLSTATE '22003' ;
 DECLARE CONTINUE HANDLER FOR overflow
   RESIGNAL SQLSTATE '22375'
   SET MESSAGE_TEXT = 'Zero division';
 IF denominator = 0 THEN
  SIGNAL overflow;
 ELSE
  SET RESULT = numerator / denominator;
 END IF;
END @


exception MyException;
exception MyDataException of int; (* can be any first-class type, not just int *)


with Ada.Strings.Unbounded;

package Markov is
   use Ada.Strings.Unbounded;
   type Ruleset (Length : Natural) is private;
   type String_Array is array (Positive range <>) of Unbounded_String;
   function Parse (S : String_Array) return Ruleset;
   function Apply (R : Ruleset; S : String) return String;
private
   type Entry_Kind is (Comment, Rule);
   type Set_Entry (Kind : Entry_Kind := Rule) is record
      case Kind is
         when Rule =>
            Source         : Unbounded_String;
            Target         : Unbounded_String;
            Is_Terminating : Boolean;
         when Comment =>
            Text           : Unbounded_String;
      end case;
   end record;
   subtype Rule_Entry is Set_Entry (Kind => Rule);
   type Entry_Array is array (Positive range <>) of Set_Entry;
   type Ruleset (Length : Natural) is record
      Entries : Entry_Array (1 .. Length);
   end record;
end Markov;


markov←{
    trim←{(~(∧\∨⌽∘(∧\)∘⌽)⍵∊⎕UCS 9 32)/⍵}
    rules←(~rules∊⎕UCS 10 13)⊆rules←80 ¯1 ⎕MAP ⍺
    rules←('#'≠⊃¨rules)/rules
    rules←{
        norm←' '@(9=⎕UCS)⊢⍵
        spos←⍸' -> '⍷norm
        pat←trim spos↑⍵
        repl←trim(spos+2)↓⍵
        term←'.'=⊃repl
        term pat(term↓repl)
    }¨rules
    apply←{
        0=⍴rule←⍸∨/¨(2⊃¨⍺)⍷¨⊂⍵:⍵
        term pat repl←⊃⍺[⊃rule]
        idx←(⊃⍸pat⍷⍵)-1
        ⍺ ∇⍣(~term)⊢(idx↑⍵),repl,(idx+≢pat)↓⍵
    }
    rules apply ⍵
}


package main

import (
    "fmt"
    "math/big"
)

func main() {
    fmt.Println(factorial(800))
}

func factorial(n int64) *big.Int {
    if n < 0 {
        return nil
    }
    r := big.NewInt(1)
    var f big.Int
    for i := int64(2); i <= n; i++ {
        r.Mul(r, f.SetInt64(i))
    }
    return r
}


capture confirm file titanium.dta
if _rc {
	if _rc==601 {
		display "the file does not exist"
	}
	else {
		* all other cases
		display "there was an error with return code " _rc
	}
}


enum MyException : ErrorType {
  case TerribleException
}


package require Tcl 8.5

# Throw
proc e {args} {
    error "error message" "error message for stack trace" {errorCode list}
}

# Catch and rethrow
proc f {} {
    if {[catch {e 1 2 3 4} errMsg options] != 0} {
        return -options $options $errMsg
    }
}

f


#lang transd

mainModule : {
  func2: (lambda i Int()
    (if (!= i 13)
      (textout "OK " i "\n")
      (throw "fail\n"))),

  func1: (lambda
    (textout "before try\n")
    (try
      (textout "before while\n")
      (with n 10
        (while (< n 15) (+= n 1)
          (func2 n)
        )
      )
      (textout "after while\n")
      (catch (report e))
    )
    (textout "after try\n")
  ),
  _start: (lambda (func1))
}


;---------------------------------------------------------------------------
; Markov Algorithm.ahk
; by wolf_II
;---------------------------------------------------------------------------
; interpreter for a Markov Algorithm
;---------------------------------------------------------------------------

;---------------------------------------------------------------------------
AutoExecute: ; auto-execute section of the script
;---------------------------------------------------------------------------
    #SingleInstance, Force          ; only one instance allowed
    #NoEnv                          ; don't check empty variables
    StartupDir := A_WorkingDir      ; remember startup directory
    SetWorkingDir, %A_ScriptDir%    ; change directoy
    StringCaseSense, On             ; case sensitive comparisons
    ;-----------------------------------------------------------------------
    AppName := "Markov Algorithm"
    Gosub, GuiCreate
    Gui, Show,, %AppName%

Return

;---------------------------------------------------------------------------
GuiCreate: ; create the GUI
;---------------------------------------------------------------------------
    ; GUI options
    Gui, -MinimizeBox
    Gui, Add, Edit, y0 h0 ; catch the focus

    ; Ruleset
    Gui, Add, GroupBox, w445 h145 Section, Ruleset
    Gui, Add, Edit, xs+15 ys+20 w300 r8 vRuleset
    Gui, Add, Button, x+15 w100, Load Ruleset
    Gui, Add, Button, wp, Save Ruleset
    Gui, Add, Button, w30, 1
    Gui, Add, Button, x+5 wp, 2
    Gui, Add, Button, x+5 wp, 3
    Gui, Add, Button, xs+330 y+6 wp, 4
    Gui, Add, Button, x+5 wp, 5

    ; String
    Gui, Add, GroupBox, xs w445 h75 Section, String
    Gui, Add, Edit, xs+15 ys+20 w300 vString
    Gui, Add, Button, x+15 w100, Apply Ruleset
    Gui, Add, Button, xp wp Hidden, Stop
    Gui, Add, CheckBox, xs+15 yp+30 vSingleStepping, Single Stepping?

    ; Output
    Gui, Add, GroupBox, xs w445 h235 Section, Output
    Gui, Add, Edit, xs+15 ys+20 w415 r15 ReadOnly vOutput HwndhOut

Return

;---------------------------------------------------------------------------
GuiClose:
;---------------------------------------------------------------------------
    ExitApp

Return

;---------------------------------------------------------------------------
ButtonLoadRuleset: ; load ruleset from file
;---------------------------------------------------------------------------
    Gui, +OwnDialogs
    FileSelectFile, RulesetFile,,, Load Ruleset, *.markov
    If Not SubStr(RulesetFile, -6) = ".markov"
        RulesetFile .= ".markov"
    If FileExist(RulesetFile) {
        FileRead, Ruleset, %RulesetFile%
        GuiControl,, Ruleset, %Ruleset%
    } Else
        MsgBox, 16, Error - %AppName%, File not found:`n`n"%RulesetFile%"

Return

;---------------------------------------------------------------------------
ButtonSaveRuleset: ; save ruleset to file
;---------------------------------------------------------------------------
    Gui, +OwnDialogs
    Gui, Submit, NoHide
    FileSelectFile, RulesetFile, S16,, Save Ruleset, *.markov
    If Not SubStr(RulesetFile, -6) = ".markov"
        RulesetFile .= ".markov"
    FileDelete, %RulesetFile%
    FileAppend, %Ruleset%, %RulesetFile%
    Gui, Show

Return

_
;---------------------------------------------------------------------------
Button1: ; http://rosettacode.org/wiki/Execute_a_Markov_algorithm#Ruleset_1
;---------------------------------------------------------------------------
    GuiControl,, Output ; clear output
    GuiControl,, String, I bought a B of As from T S.
    GuiControl,, Ruleset,
    (LTrim
    # This rules file is extracted from Wikipedia:
    # http://en.wikipedia.org/wiki/Markov_Algorithm
    A -> apple
    B -> bag
    S -> shop
    T -> the
    the shop -> my brother
    a never used -> .terminating rule
    )

Return

;---------------------------------------------------------------------------
Button2: ; http://rosettacode.org/wiki/Execute_a_Markov_algorithm#Ruleset_2
;---------------------------------------------------------------------------
    GuiControl,, Output ; clear output
    GuiControl,, String, I bought a B of As from T S.
    GuiControl,, Ruleset,
    (LTrim
    # Slightly modified from the rules on Wikipedia
    A -> apple
    B -> bag
    S -> .shop
    T -> the
    the shop -> my brother
    a never used -> .terminating rule
    )

Return

;---------------------------------------------------------------------------
Button3: ; http://rosettacode.org/wiki/Execute_a_Markov_algorithm#Ruleset_3
;---------------------------------------------------------------------------
    GuiControl,, Output ; clear output
    GuiControl,, String, I bought a B of As W my Bgage from T S.
    GuiControl,, Ruleset,
    (LTrim
    # BNF Syntax testing rules
    A -> apple
    WWWW -> with
    Bgage -> ->.*
    B -> bag
    ->.* -> money
    W -> WW
    S -> .shop
    T -> the
    the shop -> my brother
    a never used -> .terminating rule
    )

Return

;---------------------------------------------------------------------------
Button4: ; http://rosettacode.org/wiki/Execute_a_Markov_algorithm#Ruleset_4
;---------------------------------------------------------------------------
    GuiControl,, Output ; clear output
    GuiControl,, String, _1111*11111_
    GuiControl,, Ruleset,
    (LTrim
    ### Unary Multiplication Engine, for testing Markov Algorithm implementations
    ### By Donal Fellows.
    # Unary addition engine
    _+1 -> _1+
    1+1 -> 11+
    # Pass for converting from the splitting of multiplication into ordinary
    # addition
    1! -> !1
    ,! -> !+
    _! -> _
    # Unary multiplication by duplicating left side, right side times
    1*1 -> x,@y
    1x -> xX
    X, -> 1,1
    X1 -> 1X
    _x -> _X
    ,x -> ,X
    y1 -> 1y
    y_ -> _
    # Next phase of applying
    1@1 -> x,@y
    1@_ -> @_
    ,@_ -> !_
    ++ -> +
    # Termination cleanup for addition
    _1 -> 1
    1+_ -> 1
    _+_ ->
    )

Return

;---------------------------------------------------------------------------
Button5: ; http://rosettacode.org/wiki/Execute_a_Markov_algorithm#Ruleset_5
;---------------------------------------------------------------------------
    GuiControl,, Output ; clear output
    GuiControl,, String, 000000A000000
    GuiControl,, Ruleset,
    (LTrim
    # Turing machine: three-state busy beaver
    #
    # state A, symbol 0 => write 1, move right, new state B
    A0 -> 1B
    # state A, symbol 1 => write 1, move left, new state C
    0A1 -> C01
    1A1 -> C11
    # state B, symbol 0 => write 1, move left, new state A
    0B0 -> A01
    1B0 -> A11
    # state B, symbol 1 => write 1, move right, new state B
    B1 -> 1B
    # state C, symbol 0 => write 1, move left, new state B
    0C0 -> B01
    1C0 -> B11
    # state C, symbol 1 => write 1, move left, halt
    0C1 -> H01
    1C1 -> H11
    )

Return

;---------------------------------------------------------------------------
ButtonApplyRuleset: ; flow control for Algorithm
;---------------------------------------------------------------------------
    ; prepare
    Gui, Submit, NoHide
    GuiControl,, Output ; clear
    Controls(False) ; disable
    Count := 0
    Subst := True
    Stop  := False

    ; keep substituting for as long as necessary
    While, Subst {
        Subst := False ; reset control variable
        IfEqual, Stop, 1, Break
        Gosub, Algorithm
    }

    ; clean up
    Output("Substitution count: " Count)
    Controls(True) ; re-enable

Return

;---------------------------------------------------------------------------
ButtonStop: ; this button is initially hidden
;---------------------------------------------------------------------------
    Stop := True

Return

;---------------------------------------------------------------------------
Algorithm: ; http://rosettacode.org/wiki/Execute_a_Markov_algorithm
;---------------------------------------------------------------------------
    ; Parse the ruleset and apply each rule to the string. Whenever a rule
    ; has changed the string goto first rule. Continue until a encountering
    ; a terminating rule, or until no further changes to the strings are
    ; made.
    ;-----------------------------------------------------------------------
    Loop, Parse, Ruleset, `n, `r ; always start from the beginning
    {
        ; check for comment
        If SubStr(A_LoopField, 1, 1) = "#"
            Continue ; get next line

        ; split a rule into $Search, $Terminator and $Replace
        LookFor := "(?P<Search>.+) -> (?P<Terminator>\.?)(?P<Replace>.+)"
        RegExMatch(A_LoopField, LookFor, $)

        ; single stepping through possible substitutions
        If SingleStepping
            MsgBox,, %AppName%, % ""
            . "Rule = """ A_LoopField """`n`n"
            . "Search`t= """ $Search """`n"
            . "Replace`t= """ $Replace """`n"
            . "Termintor`t= """ ($Terminator ? "True" : "False") """`n"

        ; try to substitute
        StringReplace, String, String, %$Search%, %$Replace%, UseErrorLevel

        ; any success?
        If ErrorLevel {     ; yes, substitution done
            Count++         ; keep count
            Subst := True   ; set control variable
            Output(String)  ; write new string to output
        }

        ; terminate?
        If $Terminator {    ; yes, terminate
            Stop := True    ; set control variable
            Break           ; back to flow control
        }

        ; we are not yet terminated ...
        If Subst            ; but we just did a substitution
            Break           ; back to flow control
    }

Return

;---------------------------------------------------------------------------
Controls(Bool) { ; [en|dis]able controls
;---------------------------------------------------------------------------
    Enable  := Bool ? "+" : "-"
    Disable := Bool ? "-" : "+"
    Loop, 2
        GuiControl, %Disable%ReadOnly, % "Edit" A_Index + 1
    Loop, 7
        GuiControl, %Disable%Disabled, % "Button" A_Index + 1
    GuiControl, %Disable%Disabled, Edit4
    GuiControl, %Disable%Hidden, Button10
    GuiControl, %Enable%Hidden, Button11
    GuiControl, %Disable%Disabled, Button12
}

;---------------------------------------------------------------------------
Output(Text) { ; append text to output
;---------------------------------------------------------------------------
    static EM_REPLACESEL = 0xC2
    global hOut
    Sleep, 100
    Text .= "`r`n"
    SendMessage, EM_REPLACESEL,, &Text,, ahk_id %hOut%
}

;---------- end of file ----------------------------------------------------


#include <order/interpreter.h>

#define ORDER_PP_DEF_8fib_rec                     \
ORDER_PP_FN(8fn(8N,                               \
                8if(8less(8N, 2),                 \
                    8N,                           \
                    8add(8fib_rec(8sub(8N, 1)),   \
                         8fib_rec(8sub(8N, 2))))))

ORDER_PP(8fib_rec(10))


#FACTORIAL.

@width 14
@height 8

(1,3):START
(7,1):CHECKPOINT 0
(3,3):INPUT INT TO n
(5,3):STORE n
(7,3):GO EAST
(9,3):DECREMENT n
(11,3):SWITCH n
(11,5):MULTIPLY BY n
(11,7):GOTO 0
(13,3):PRINT


try
	invalid "this statement will fail"
catch syntaxerror
	# console.err is optional here
	out "caught an exception" endl console.err
end try


#import std

thrower = ~&?/'success'! -[epic fail]-!%

catcher = guard(thrower,---[someone failed]-)


[myproc
  ['new error' 1 2 3] throw
  'should not come here' puts
].


Sub foo1()
    err.raise(vbObjectError + 1050)
End Sub

Sub foo2()
    Error vbObjectError + 1051
End Sub


      PRINT FNmarkov("ruleset1.txt", "I bought a B of As from T S.")
      PRINT FNmarkov("ruleset2.txt", "I bought a B of As from T S.")
      PRINT FNmarkov("ruleset3.txt", "I bought a B of As W my Bgage from T S.")
      PRINT FNmarkov("ruleset4.txt", "_1111*11111_")
      PRINT FNmarkov("ruleset5.txt", "000000A000000")
      END

      DEF FNmarkov(rulefile$, text$)
      LOCAL i%, done%, rules%, rule$, old$, new$
      rules% = OPENIN(rulefile$)
      IF rules%=0 ERROR 100, "Cannot open rules file"
      REPEAT
        rule$ = GET$#rules%
        IF ASC(rule$)<>35 THEN
          REPEAT
            i% = INSTR(rule$, CHR$(9))
            IF i% MID$(rule$,i%,1) = " "
          UNTIL i%=0
          i% = INSTR(rule$, " -> ")
          IF i% THEN
            old$ = LEFT$(rule$,i%-1)
            WHILE RIGHT$(old$)=" " old$ = LEFT$(old$) : ENDWHILE
            new$ = MID$(rule$,i%+4)
            WHILE ASC(new$)=32 new$ = MID$(new$,2) : ENDWHILE
            IF ASC(new$)=46 new$ = MID$(new$,2) : done% = TRUE
            i% = INSTR(text$,old$)
            IF i% THEN
              text$ = LEFT$(text$,i%-1) + new$ + MID$(text$,i%+LEN(old$))
              PTR#rules% = 0
            ENDIF
          ENDIF
        ENDIF
      UNTIL EOF#rules% OR done%
      CLOSE #rules%
      = text$


markov=
{
First the patterns that describe the rules syntax.
This is a naive and not very efficient way to parse the rules, but it closely
matches the problem description, which is nice.
}
    ( ruleset
    =     >%@" " ?   { Added: assume that a rule cannot start with whitespace.
                       The %@ say that the thing to match must be exactly one
                       byte. % means 'one or more'. @ means 'zero or one'.
                     }
        : ((!comment|!rule) !newlines) !ruleset
      |         { Recursion terminates here: match empty string. }
    )
  & (comment="#" ?com)
  & ( rule
    =   %?pattern
        !whitespace
        "->"
        !whitespace
        ( "." %?replacement&stop:?stop
        | %?replacement
        )
    )
  & ( whitespace
    = (\t|" ") (!whitespace|)
    )
  & ( newlines
    =   ( (\n|\r)
        & ( :!pattern:!replacement {Do nothing. We matched an empty line.}
          |   (!pattern.!replacement.!stop) !rules:?rules
                {
                Add pattern, replacement and the stop (empty string or "stop")
                to a list of triplets. This list will contain the rules in
                reverse order.
                Then, reset these variables, so they are not added once more
                if an empty line follows.
                }
            & :?stop:?pattern:?replacement
          )
        )
        (!newlines|)
    )
{
Compile the textual rules to a single Bracmat pattern.
}
  & ( compileRules
    =   stop pattern replacement rules,pat rep stp
      .   :?stop:?pattern:?replacement:?rules
                {
                Important! Initialise these variables.
                }
        & @(!arg:!ruleset)
                {
                That's all. The textual rules are parsed and converted to a
                list of triplets. The rules in the list are in reversed order.
                }
        & !rules:(?pat.?rep.?stp) ?rules
                {
                The head of the list is the last rule. Use it to initialise
                the pattern "ruleSetAsPattern".
                The single quote introduces a macro substition. All symbols
                preceded with a $ are substituted.
                }
        &
            ' ( ?A ()$pat ?Z
              & $stp:?stop
              & $rep:?replacement
              )
          : (=?ruleSetAsPattern)
                {
                Add all remaining rules as new subpatterns to
                "ruleSetAsPattern". Separate with the OR symbol.
                }
        &   whl
          ' ( !rules:(?pat.?rep.?stp) ?rules
            &
                ' (   ?A ()$pat ?Z
                    & $stp:?stop
                    & $rep:?replacement
                  | $ruleSetAsPattern
                  )
              : (=?ruleSetAsPattern)
            )
        & '$ruleSetAsPattern
    )
        {
        Function that takes two arguments: a rule set (as text)
        and a subject string.
        The function returns the transformed string.
        }
  & ( applyRules
    =     rulesSetAsText subject ruleSetAsPattern
        , A Z replacement stop
      .   !arg:(?rulesSetAsText.?subject)
        & compileRules$!rulesSetAsText:(=?ruleSetAsPattern)
                {
                Apply rule until no match
                or until variable "stop" has been set to the value "stop".
                }
        &   whl
          ' ( @(!subject:!ruleSetAsPattern)
            & str$(!A !replacement !Z):?subject
            & !stop:~stop
            )
        & !subject
    )
{
Tests:
}
  &   out
    $ ( applyRules
      $ ( "# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
A -> apple
B -> bag
S -> shop
T -> the
the shop -> my brother
a never used -> .terminating rule
"
        . "I bought a B of As from T S."
        )
      )
  &   out
    $ ( applyRules
      $ ( "# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule
"
        . "I bought a B of As from T S."
        )
      )
  &   out
    $ ( applyRules
      $ ( "# BNF Syntax testing rules
A -> apple
WWWW -> with
Bgage -> ->.*
B -> bag
->.* -> money
W -> WW
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule
"
        . "I bought a B of As W my Bgage from T S."
        )
      )
  &   out
    $ ( applyRules
      $ ( "### Unary Multiplication Engine, for testing Markov Algorithm implementations
### By Donal Fellows.
# Unary addition engine
_+1 -> _1+
1+1 -> 11+
# Pass for converting from the splitting of multiplication into ordinary
# addition
1! -> !1
,! -> !+
_! -> _
# Unary multiplication by duplicating left side, right side times
1*1 -> x,@y
1x -> xX
X, -> 1,1
X1 -> 1X
_x -> _X
,x -> ,X
y1 -> 1y
y_ -> _
# Next phase of applying
[email protected] -> x,@y
[email protected]_ -> @_
,@_ -> !_
++ -> +
# Termination cleanup for addition
_1 -> 1
1+_ -> 1
_+_ ->
"
        . "_1111*11111_"
        )
      )
  &   out
    $ ( applyRules
      $ ( "# Turing machine: three-state busy beaver
#
# state A, symbol 0 => write 1, move right, new state B
A0 -> 1B
# state A, symbol 1 => write 1, move left, new state C
0A1 -> C01
1A1 -> C11
# state B, symbol 0 => write 1, move left, new state A
0B0 -> A01
1B0 -> A11
# state B, symbol 1 => write 1, move right, new state B
B1 -> 1B
# state C, symbol 0 => write 1, move left, new state B
0C0 -> B01
1C0 -> B11
# state C, symbol 1 => write 1, move left, halt
0C1 -> H01
1C1 -> H11
"
        . 000000A000000
        )
      )
  & ok
| failure;


fun{FibI N}
  Temp = {NewCell 0}
  A = {NewCell 0}
  B = {NewCell 1}
in
  for I in 1..N do
    Temp := @A + @B
    A := @B
    B := @Temp
  end
  @A
end


def rFact
rFact = { (it > 1) ? it * rFact(it - 1) : 1 as BigInteger }


Class MyException
  Inherits Exception
  'data with info about exception
End Class


var intDiv = Fn.new { |a, b|
    if (!(a is Num && a.isInteger) || !(b is Num && b.isInteger)) Fiber.abort("Invalid argument(s).")
    if (b == 0) Fiber.abort("Division by zero error.")
    if (a == 0) a = a.badMethod()
    return (a/b).truncate
}

var a = [ [6, 2], [6, 0], [10, 5], [true, false], [0, 2] ]
for (e in a) {
    var d
    var f = Fiber.new { d = intDiv.call(e[0], e[1]) }
    f.try()
    if (f.error) {
        System.print("Caught %(f.error)")
    } else {
        System.print("%(e[0]) / %(e[1]) = %(d)")
    }
}


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <fcntl.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <ctype.h>

typedef struct { char * s; size_t alloc_len; } string;

typedef struct {
    char *pat, *repl;
    int terminate;
} rule_t;

typedef struct {
    int n;
    rule_t *rules;
    char *buf;
} ruleset_t;

void ruleset_del(ruleset_t *r)
{
    if (r->rules) free(r->rules);
    if (r->buf) free(r->buf);
    free(r);
}

string * str_new(const char *s)
{
    int l = strlen(s);
    string *str = malloc(sizeof(string));
    str->s = malloc(l + 1);
    strcpy(str->s, s);
    str->alloc_len = l + 1;
    return str;
}

void str_append(string *str, const char *s, int len)
{
    int l = strlen(str->s);
    if (len == -1) len = strlen(s);

    if (str->alloc_len < l + len + 1) {
        str->alloc_len = l + len + 1;
        str->s = realloc(str->s, str->alloc_len);
    }
    memcpy(str->s + l, s, len);
    str->s[l + len] = '\0';
}

/* swap content of dest and src, and truncate src string */
void str_transfer(string *dest, string *src)
{
    size_t tlen = dest->alloc_len;
    dest->alloc_len = src->alloc_len;
    src->alloc_len = tlen;

    char *ts = dest->s;
    dest->s = src->s;
    src->s = ts;
    src->s[0] = '\0';
}

void str_del(string *s)
{
    if (s->s) free(s->s);
    free(s);
}

void str_markov(string *str, ruleset_t *r)
{
    int i, j, sl, pl;
    int changed = 0, done = 0;
    string *tmp = str_new("");

    while (!done) {
        changed = 0;
        for (i = 0; !done && !changed && i < r->n; i++) {
            pl = strlen(r->rules[i].pat);
            sl = strlen(str->s);
            for (j = 0; j < sl; j++) {
                if (strncmp(str->s + j, r->rules[i].pat, pl))
                    continue;
                str_append(tmp, str->s, j);
                str_append(tmp, r->rules[i].repl, -1);
                str_append(tmp, str->s + j + pl, -1);

                str_transfer(str, tmp);
                changed = 1;

                if (r->rules[i].terminate)
                    done = 1;
                break;
            }
        }
        if (!changed) break;
    }
    str_del(tmp);
    return;
}

ruleset_t* read_rules(const char *name)
{
    struct stat s;
    char *buf;
    size_t i, j, k, tmp;
    rule_t *rules = 0;
    int n = 0; /* number of rules */

    int fd = open(name, O_RDONLY);
    if (fd == -1) return 0;

    fstat(fd, &s);
    buf = malloc(s.st_size + 2);
    read(fd, buf, s.st_size);
    buf[s.st_size] = '\n';
    buf[s.st_size + 1] = '\0';
    close(fd);

    for (i = j = 0; buf[i] != '\0'; i++) {
        if (buf[i] != '\n') continue;

        /* skip comments */
        if (buf[j] == '#' || i == j) {
            j = i + 1;
            continue;
        }

        /* find the '->' */
        for (k = j + 1; k < i - 3; k++)
            if (isspace(buf[k]) && !strncmp(buf + k + 1, "->", 2))
                break;

        if (k >= i - 3) {
            printf("parse error: no -> in %.*s\n", i - j, buf + j);
            break;
        }

        /* left side: backtrack through whitespaces */
        for (tmp = k; tmp > j && isspace(buf[--tmp]); );
        if (tmp < j) {
            printf("left side blank? %.*s\n", i - j, buf + j);
            break;
        }
        buf[++tmp] = '\0';

        /* right side */
        for (k += 3; k < i && isspace(buf[++k]););
        buf[i] = '\0';

        rules = realloc(rules, sizeof(rule_t) * (1 + n));
        rules[n].pat = buf + j;

        if (buf[k] == '.') {
            rules[n].terminate = 1;
            rules[n].repl = buf + k + 1;
        } else {
            rules[n].terminate = 0;
            rules[n].repl = buf + k;
        }
        n++;

        j = i + 1;
    }

    ruleset_t *r = malloc(sizeof(ruleset_t));
    r->buf = buf;
    r->rules = rules;
    r->n = n;
    return r;
}

int test_rules(const char *s, const char *file)
{
    ruleset_t * r = read_rules(file);
    if (!r) return 0;
    printf("Rules from '%s' ok\n", file);

    string *ss = str_new(s);
    printf("text:     %s\n", ss->s);

    str_markov(ss, r);
    printf("markoved: %s\n", ss->s);

    str_del(ss);
    ruleset_del(r);

    return printf("\n");
}

int main()
{
    /* rule 1-5 are files containing rules from page top */
    test_rules("I bought a B of As from T S.", "rule1");
    test_rules("I bought a B of As from T S.", "rule2");
    test_rules("I bought a B of As W my Bgage from T S.", "rule3");
    test_rules("_1111*11111_", "rule4");
    test_rules("000000A000000", "rule5");

    return 0;
}


static function factorial(n:Int):Int {
  var result = 1;
  while (1<n)
    result *= n--;
  return result;
}


fun fac n
  let acc 1
  while n > 0
    let acc (acc * n--)
  endwhile
  return acc
endfun


try{ throw(Exception.BadDay) }
catch { println(__exception," was thrown") }
fallthrough {  println("No exception was thrown") }
println("OK");


const std = @import("std");
// To replace exceptions, Zig has error enums to handle error states.

pub fn main() !void {
    // writing to stdout as file descriptor might fail,
    // if we are a child process and the parent process has closed it
    const stdout_wr = std.io.getStdOut().writer();
    try stdout_wr.writeAll("a");
    // Above code is identical to
    stdout_wr.writeAll("a") catch |err| return err;
    stdout_wr.writeAll("a") catch |err| {
        // usually std streams are leaked and the Kernel cleans them up
        var stdin = std.io.getStdIn();
        var stderr = std.io.getStdErr();
        stdin.close();
        stderr.close();
        return err;
    };
}


#include <cstdlib>
#include <iostream>
#include <fstream>
#include <vector>
#include <string>

struct rule
{
  std::string pattern;
  std::string replacement;
  bool terminal;
  rule(std::string pat, std::string rep, bool term):
    pattern(pat),
    replacement(rep),
    terminal(term)
  {
  }
};

std::string const whitespace = " \t";
std::string::size_type const npos = std::string::npos;

bool is_whitespace(char c)
{
  return whitespace.find(c) != npos;
}

std::vector<rule> read_rules(std::ifstream& rulefile)
{
  std::vector<rule> rules;
  std::string line;
  while (std::getline(rulefile, line))
  {
    std::string::size_type pos;

    // remove comments
    pos = line.find('#');
    if (pos != npos)
      line.resize(pos);

    // ignore lines consisting only of whitespace
    if (line.find_first_not_of(whitespace) == npos)
      continue;

    // find "->" surrounded by whitespace
    pos = line.find("->");
    while (pos != npos && (pos == 0 || !is_whitespace(line[pos-1])))
      pos = line.find("->", pos+1);

    if (pos == npos || line.length() < pos+3 || !is_whitespace(line[pos+2]))
    {
      std::cerr << "invalid rule: " << line << "\n";
      std::exit(EXIT_FAILURE);
    }

    std::string pattern = line.substr(0, pos-1);
    std::string replacement = line.substr(pos+3);

    // remove additional separating whitespace
    pattern.erase(pattern.find_last_not_of(whitespace)+1);
    replacement.erase(0, replacement.find_first_not_of(whitespace));

    // test for terminal rule
    bool terminal = !replacement.empty() && replacement[0] == '.';
    if (terminal)
      replacement.erase(0,1);

    rules.push_back(rule(pattern, replacement, terminal));
  }

  return rules;
}

std::string markov(std::vector<rule> rules, std::string input)
{
  std::string& output = input;
  std::vector<rule>::iterator iter = rules.begin();

  // Loop through each rule, transforming our current version
  // with each rule.
  while (iter != rules.end())
  {
    std::string::size_type pos = output.find(iter->pattern);
    if (pos != npos)
    {
      output.replace(pos, iter->pattern.length(), iter->replacement);
      if (iter->terminal)
        break;
      iter = rules.begin();
    }
    else
      ++iter;
  }

  return output;
}

int main(int argc, char* argv[])
{
  if (argc != 3)
  {
    std::cout << "usage:\n " << argv[0] << " rulefile text\n";
    return EXIT_FAILURE;
  }

  std::ifstream rulefile(argv[1]);
  std::vector<rule> rules = read_rules(rulefile);

  std::string input(argv[2]);
  std::string output = markov(rules, input);

  std::cout << output << "\n";
}


function fib(n: integer):longInt;
const
  Sqrt5 = sqrt(5.0);
  C1 = ln((Sqrt5+1.0)*0.5);//ln( 1.618..)
//C2 = ln((1.0-Sqrt5)*0.5);//ln(-0.618 )) tsetsetse
  C2 = ln((Sqrt5-1.0)*0.5);//ln(+0.618 ))
begin
  IF n>0 then
  begin
    IF odd(n) then
      fib := round((exp(C1*n) + exp(C2*n) )/Sqrt5)
    else
      fib := round((exp(C1*n) - exp(C2*n) )/Sqrt5)
  end
  else
    Fibdirekt := 0
end;


WRITE(Clipboard) factorial(6)  ! pasted: 720

FUNCTION factorial(n)
   factorial = 1
   DO i = 2, n
      factorial = factorial * i
   ENDDO
END


markov = cluster is make, run
    rule = struct[from, to: string, term: bool]
    rep = array[rule]

    % Remove leading and trailing whitespace from a string
    trim = proc (s: string) returns (string)
        ac = array[char]
        sc = sequence[char]
        own ws: string := "\n\t "
        a: ac := string$s2ac(s)
        while ~ac$empty(a) cand string$indexc(ac$bottom(a), ws) ~= 0 do
            ac$reml(a)
        end
        while ~ac$empty(a) cand string$indexc(ac$top(a), ws) ~= 0 do
            ac$remh(a)
        end
        return(string$sc2s(sc$a2s(a)))
    end trim

    % Parse a single Markov rule
    parse = proc (s: string) returns (rule) signals (comment, invalid(string))
        if string$empty(s) cor s[1]='#' then signal comment end
        arrow: int := string$indexs(" -> ", s)
        if arrow=0 then signal invalid(s) end
        left: string := trim(string$substr(s, 1, arrow-1))
        right: string := trim(string$rest(s, arrow+4))

        if ~string$empty(right) cand right[1] = '.' then
            right := string$rest(right, 2)
            return(rule${from: left, to: right, term: true})
        else
            return(rule${from: left, to: right, term: false})
        end
    end parse

    % Add a rule to the list
    add_rule = proc (m: cvt, s: string) signals (invalid(string))
        rep$addh(m, parse(s)) resignal invalid
        except when comment: end
    end add_rule

    % Read rules in sequence from a stream
    add_rules = proc (m: cvt, s: stream) signals (invalid(string))
        while true do
            add_rule(up(m), stream$getl(s)) resignal invalid
            except when end_of_file: break end
        end
    end add_rules

    make = proc (s: stream) returns (cvt) signals (invalid(string))
        a: rep := rep$new()
        add_rules(up(a), s)
        return(a)
    end make

    % Apply a rule to a string
    apply_rule = proc (r: rule, s: string) returns (string) signals (no_match)
        match: int := string$indexs(r.from, s)
        if match = 0 then signal no_match end
        new: string := string$substr(s, 1, match-1)
                    || r.to
                    || string$rest(s, match+string$size(r.from))
        return(new)
    end apply_rule

    % Apply all rules to a string repeatedly
    run = proc (c: cvt, s: string) returns (string)
        i: int := 1
        while i <= rep$high(c) do
            r: rule := c[i]
            begin
                s := apply_rule(r, s)
                i := 1
                if r.term then break end
            end except when no_match:
                i := i+1
            end
        end
        return(s)
    end run
end markov

start_up = proc ()
    po: stream := stream$primary_output()
    eo: stream := stream$error_output()

    begin
        args: sequence[string] := get_argv()
        file: string := args[1]
        input: string := args[2]
        fs: stream := stream$open(file_name$parse(file), "read")
        mkv: markov := markov$make(fs)
        stream$close(fs)
        stream$putl(po, markov$run(mkv, input))
    end except
        when bounds: stream$putl(eo, "Arguments: markov [filename] [string]")
        when not_possible(s: string): stream$putl(eo, "File error: " || s)
        when invalid(s: string): stream$putl(eo, "Parse error: " || s)
    end
end start_up


;;; Keeps track of all our rules
(defclass markov ()
  ((rules :initarg :rules :initform nil :accessor rules)))

;;; Definition of a rule
(defclass rule ()
  ((pattern :initarg :pattern :accessor pattern)
   (replacement :initarg :replacement :accessor replacement)
   (terminal :initform nil :initarg :terminal :accessor terminal)))

;;; Parse a rule with this regular expression
(defparameter *rex->* (compile-re "^(.+)(?: |\\t)->(?: |\\t)(\\.?)(.*)$"))

;;; Create a rule and add it to the markov object
(defmethod update-markov ((mkv markov) lhs terminating rhs)
  (setf (rules mkv) (cons
                     (make-instance 'rule :pattern lhs :replacement rhs :terminal terminating)
                     (rules mkv))))

;;; Parse a line and add it to the markov object
(defmethod parse-line ((mkv markov) line)
  (let ((trimmed (string-trim #(#\Space #\Tab) line)))
    (if (not (or
              (eql #\# (aref trimmed 0))
              (equal "" trimmed)))
        (let ((vals (multiple-value-list (match-re *rex->* line))))
          (if (not (car vals))
              (progn
                (format t "syntax error in ~A" line)
                (throw 'fail t)))
          (update-markov mkv (nth 2 vals) (equal "." (nth 3 vals)) (nth 4 vals))))))

;;; Make a markov object from the string of rules
(defun make-markov (rules-text)
  (catch 'fail
         (let ((mkv (make-instance 'markov)))
           (with-input-from-string (s rules-text)
             (loop for line = (read-line s nil)
                 while line do
                   (parse-line mkv line)))
           (setf (rules mkv) (reverse (rules mkv)))
           mkv)))

;;; Given a rule and bounds where it applies, apply it to the input text
(defun adjust (rule-info text)
  (let* ((rule (car rule-info))
         (index-start (cadr rule-info))
         (index-end (caddr rule-info))
         (prefix (subseq text 0 index-start))
         (suffix (subseq text index-end))
         (replace (replacement rule)))
    (concatenate 'string prefix replace suffix)))

;;; Get the next applicable rule or nil if none
(defmethod get-rule ((markov markov) text)
  (dolist (rule (rules markov) nil)
    (let ((index (search (pattern rule) text)))
      (if index
          (return (list rule index (+ index (length (pattern rule)))))))))

;;; Interpret text using a markov object
(defmethod interpret ((markov markov) text)
  (let ((rule-info (get-rule markov text))
        (ret text))
    (loop (if (not rule-info) (return ret))
          (setf ret (adjust rule-info ret))
          (if (terminal (car rule-info)) (return ret))
          (setf rule-info (get-rule markov ret)))))


U64 Factorial(U64 n) {
  U64 i, result = 1;
  for (i = 1; i <= n; ++i)
    result *= i;
  return result;
}

Print("1:  %d\n", Factorial(1));
Print("10: %d\n", Factorial(10));


include "cowgol.coh";
include "strings.coh";
include "malloc.coh";
include "argv.coh";
include "file.coh";

record Rule is
    pattern: [uint8];
    replacement: [uint8];
    next: [Rule];
    terminates: uint8;
end record;

sub AllocRule(): (rule: [Rule]) is
    rule := Alloc(@bytesof Rule) as [Rule];
    MemZero(rule as [uint8], @bytesof Rule);
end sub;

sub ParseRule(text: [uint8]): (rule: [Rule]) is
    sub ParseError() is
        print("Failed to parse rule: ");
        print(text);
        print_nl();
        ExitWithError();
    end sub;

    var cur := text;
    sub SkipWs() is
        while [cur] != 0 and [cur] <= ' ' loop cur := @next cur; end loop;
    end sub;

    sub AllocAndCopy(src: [uint8], length: intptr): (copy: [uint8]) is
        copy := Alloc(length + 1);
        MemCopy(src, length, copy);
        [copy + length] := 0;
    end sub;

    SkipWs();
    if [cur] == '#' or [cur] == 0 then # comment or empty line
        rule := 0 as [Rule];
        return;
    end if;
    var patternStart := cur;

    # find the " ->"
    while [cur] != 0
    and ([cur] > ' ' or [cur+1] != '-' or [cur+2] != '>') loop
        cur := @next cur;
    end loop;
    if [cur] == 0 then ParseError(); end if;

    # find last char of pattern
    var patternEnd := cur;
    while patternStart < patternEnd and [patternEnd] <= ' ' loop
        patternEnd := @prev patternEnd;
    end loop;

    cur := cur + 3; # whitespace + '->'
    SkipWs();
    var replacementStart := cur;

    # find last char of replacement
    while [cur] != 0 loop cur := @next cur; end loop;
    while replacementStart < cur and [cur] <= ' ' loop
        cur := @prev cur;
    end loop;

    # make rule object
    rule := AllocRule();
    rule.pattern := AllocAndCopy(patternStart, patternEnd-patternStart+1);
    if [replacementStart] == '.' then
        rule.terminates := 1;
        replacementStart := @next replacementStart;
    end if;
    rule.replacement := AllocAndCopy(replacementStart, cur-replacementStart+1);
end sub;

sub FindMatch(needle: [uint8], haystack: [uint8]): (match: [uint8]) is
    match := 0 as [uint8];
    while [haystack] != 0 loop
        var n := needle;
        var h := haystack;
        while [n] != 0 and [h] != 0 and [n] == [h] loop
            n := @next n;
            h := @next h;
        end loop;
        if [n] == 0 then
            match := haystack;
            return;
        end if;
        haystack := @next haystack;
    end loop;
end sub;

const NO_MATCH := 0;
const HALT := 1;
const CONTINUE := 2;
sub ApplyRule(rule: [Rule], in: [uint8], out: [uint8]): (result: uint8) is
    var match := FindMatch(rule.pattern, in);
    if match == 0 as [uint8] then
        result := NO_MATCH;
    else
        var len := StrLen(rule.replacement);
        var patlen := StrLen(rule.pattern);
        var rest := match + patlen;
        MemCopy(in, match-in, out);
        MemCopy(rule.replacement, len, out+(match-in));
        CopyString(rest, out+(match-in)+len);
        if rule.terminates != 0 then
            result := HALT;
        else
            result := CONTINUE;
        end if;
    end if;
end sub;

sub ApplyRules(rules: [Rule], buffer: [uint8]): (r: [uint8]) is
    var outbuf: uint8[256];
    var rule := rules;
    r := buffer;

    while rule != 0 as [Rule] loop
        case ApplyRule(rule, buffer, &outbuf[0]) is
            when NO_MATCH:
                rule := rule.next;
            when HALT:
                CopyString(&outbuf[0], buffer);
                return;
            when CONTINUE:
                CopyString(&outbuf[0], buffer);
                rule := rules;
        end case;
    end loop;
end sub;

sub ReadFile(filename: [uint8]): (rules: [Rule]) is
    var linebuf: uint8[256];
    var fcb: FCB;
    var bufptr := &linebuf[0];

    rules := 0 as [Rule];
    var prevRule := 0 as [Rule];

    if FCBOpenIn(&fcb, filename) != 0 then
        print("Cannot open file: ");
        print(filename);
        print_nl();
        ExitWithError();
    end if;

    var length := FCBExt(&fcb);
    var ch: uint8 := 1;
    while length != 0 and ch != 0 loop
        ch := FCBGetChar(&fcb);
        length := length - 1;
        [bufptr] := ch;
        bufptr := @next bufptr;

        if ch == '\n' then
            [bufptr] := 0;
            bufptr := &linebuf[0];
            var rule := ParseRule(&linebuf[0]);
            if rule != 0 as [Rule] then
                if rules == 0 as [Rule] then rules := rule; end if;
                if prevRule != 0 as [Rule] then prevRule.next := rule; end if;
                prevRule := rule;
            end if;
        end if;
    end loop;

    var dummy := FCBClose(&fcb);
end sub;

ArgvInit();
var fname := ArgvNext();
if fname == 0 as [uint8] then
    print("usage: markov [pattern file] [pattern]\n");
    ExitWithError();
end if;

var patbuf: uint8[256];
var patptr := &patbuf[0];
loop
    var patpart := ArgvNext();
    if patpart == 0 as [uint8] then
        if patptr != &patbuf[0] then patptr := @prev patptr; end if;
        [patptr] := 0;
        break;
    end if;
    var partlen := StrLen(patpart);
    MemCopy(patpart, partlen, patptr);
    patptr := patptr + partlen + 1;
    [@prev patptr] := ' ';
end loop;

print(ApplyRules(ReadFile(fname), &patbuf[0]));
print_nl();


void main() {
    import std.stdio, std.file, std.regex, std.string, std.range,
           std.functional;

    const rules = "markov_rules.txt".readText.splitLines.split("");
    auto tests = "markov_tests.txt".readText.splitLines;
    auto re = ctRegex!(r"^([^#]*?)\s+->\s+(\.?)(.*)"); // 160 MB RAM.

    alias slZip = curry!(zip, StoppingPolicy.requireSameLength);
    foreach (test, const rule; slZip(tests, rules)) {
        const origTest = test.dup;

        string[][] capt;
        foreach (const line; rule) {
            auto m = line.match(re);
            if (!m.empty) {
                //capt.put(m.captures.dropOne);
                capt ~= m.captures.dropOne.array;
            }
        }

    REDO:
        const copy = test;
        foreach (const c; capt) {
            test = test.replace(c[0], c[2]);
            if (c[1] == ".")
                break;
            if (test != copy)
                goto REDO;
        }
        writefln("%s\n%s\n", origTest, test);
    }
}


function fibonacci(integer n)     -- iterative, works for -ve numbers
atom a=0, b=1
    if n=0 then return 0 end if
    if abs(n)>=79 then ?9/0 end if  -- inaccuracies creep in above 78
    for i=1 to abs(n)-1 do
        {a,b} = {b,a+b}
    end for
    if n<0 and remainder(n,2)=0 then return -b end if
    return b
end function

for i=0 to 28 do
    if i then puts(1,", ") end if
    printf(1,"%d", fibonacci(i))
end for
puts(1,"\n")


concept factorial(n) {
	return n!
}

software {
	print(factorial(-23))
	print(factorial(0))
	print(factorial(1))
	print(factorial(2))
	print(factorial(3))
	print(factorial(22))
}


procedure factorial(n)
   n := integer(n) | runerr(101, n)
   if n < 0 then fail
   return if n = 0 then 1 else n*factorial(n-1)
end


(remove-comments) text:
    ]
    for line in text:
        if and line not starts-with line "#":
            line
    [

(markov-parse) text:
    ]
    for line in text:
        local :index find line " -> "
        local :pat slice line 0 index
        local :rep slice line + index 4 len line
        local :term starts-with rep "."
        if term:
            set :rep slice rep 1 len rep
        & pat & term rep
    [

markov-parse:
    (markov-parse) (remove-comments) split !decode!utf-8 !read!stdin "\n"

(markov-tick) rules start:
    for rule in copy rules:
        local :pat &< rule
        local :rep &> dup &> rule
        local :term &<
        local :index find start pat
        if < -1 index:
            )
            slice start + index len pat len start
            rep
            slice start 0 index
            concat(
            return term
    true start

markov rules:
    true
    while:
        not (markov-tick) rules

!. markov markov-parse get-from !args 1


;; rule := (pattern replacement [#t terminal])

(define-syntax-rule  (pattern rule) (first rule))
(define-syntax-rule  (repl sule) (second rule))
(define-syntax-rule  (term? rule) (!empty? (cddr rule)))

;; (alpha   .beta )--> (alpha beta #t)
(define (term-rule rule)
        (if (string=? (string-first (repl rule)) ".")
            (list (pattern rule) (string-rest (repl rule)) #t)
            rule ))

;; returns list of rules
(define (parse-rules lines)
    (map term-rule
    (for/list [(line (string-split lines "\n"))]
        #:continue (string=? (string-first line) "#")
        (map string-trim
        (string-split (string-replace line "/\\t/g" " ") " -> ")))))

;; markov machine
(define (markov i-string rules)
    (while
        (for/fold (run #f) ((rule rules))
        #:when (string-index (pattern rule) i-string)
          (set! i-string (string-replace i-string (pattern rule) (repl rule)))
            ;;(writeln rule i-string) ;; uncomment for trace
            #:break (term? rule)  => #f
            #:break #t  => #t ))
    i-string)

(define (task i-string  RS)
    (markov i-string (parse-rules RS)))


def Fibonacci
    dup 0 < if
        "Invalid argument: " print
    else
        1 1 rot 2 -
        for
            drop
            over over +
        endfor
    endif
enddef

10 Fibonacci pstack print nl
-10 Fibonacci print


function fact,n
   return, product(lindgen(n)+1)
end


open System
open System.IO
open System.Text.RegularExpressions

type Rule = {
    matches : Regex
    replacement : string
    terminate : bool
}

let (|RegexMatch|_|) regexStr input =
    let m = Regex.Match(input, regexStr, RegexOptions.ExplicitCapture)
    if m.Success then Some (m) else None

let (|RuleReplace|_|) rule input =
    let replaced = rule.matches.Replace(input, rule.replacement, 1, 0)
    if input = replaced then None
    else Some (replaced, rule.terminate)

let parseRules line =
    match line with
    | RegexMatch "^#" _ -> None
    | RegexMatch "(?<pattern>.*?)\s+->\s+(?<replacement>.*)$" m ->
        let replacement = (m.Groups.Item "replacement").Value
        let terminate = replacement.Length > 0 && replacement.Substring(0,1) = "."
        let pattern = (m.Groups.Item "pattern").Value
        Some {
            matches = pattern |> Regex.Escape |> Regex;
            replacement = if terminate then replacement.Substring(1) else replacement;
            terminate = terminate
        }
    | _ -> failwith "illegal rule definition"

let rec applyRules input = function
| [] -> (input, true)
| rule::rules ->
    match input with
    | RuleReplace rule (withReplacement, terminate) ->
        (withReplacement, terminate)
    | _ -> applyRules input rules

[<EntryPoint>]
let main argv =
    let rules = File.ReadAllLines argv.[0] |> Array.toList |> List.choose parseRules
    let rec run input =
        let output, terminate = applyRules input rules
        if terminate then output
        else run output

    Console.ReadLine()
    |> run
    |> printfn "%s"
    0


function fibIter($n) {
    if ($n < 2) {
        return $n;
    }
    $fibPrev = 0;
    $fib = 1;
    foreach (range(1, $n-1) as $i) {
        list($fibPrev, $fib) = array($fib, $fib + $fibPrev);
    }
    return $fib;
}


[ factorial n;
  if(n == 0)
    return 1;
  else
    return n * factorial(n - 1);
];


package main

import (
    "fmt"
    "regexp"
    "strings"
)

type testCase struct {
    ruleSet, sample, output string
}

func main() {
    fmt.Println("validating", len(testSet), "test cases")
    var failures bool
    for i, tc := range testSet {
        if r, ok := interpret(tc.ruleSet, tc.sample); !ok {
            fmt.Println("test", i+1, "invalid ruleset")
            failures = true
        } else if r != tc.output {
            fmt.Printf("test %d: got %q, want %q\n", i+1, r, tc.output)
            failures = true
        }
    }
    if !failures {
        fmt.Println("no failures")
    }
}

func interpret(ruleset, input string) (string, bool) {
    if rules, ok := parse(ruleset); ok {
        return run(rules, input), true
    }
    return "", false
}

type rule struct {
    pat  string
    rep  string
    term bool
}

var (
    rxSet   = regexp.MustCompile(ruleSet)
    rxEle   = regexp.MustCompile(ruleEle)
    ruleSet = `(?m:^(?:` + ruleEle + `)*$)`
    ruleEle = `(?:` + comment + `|` + ruleRe + `)\n+`
    comment = `#.*`
    ruleRe  = `(.*)` + ws + `->` + ws + `([.])?(.*)`
    ws      = `[\t ]+`
)

func parse(rs string) ([]rule, bool) {
    if !rxSet.MatchString(rs) {
        return nil, false
    }
    x := rxEle.FindAllStringSubmatchIndex(rs, -1)
    var rules []rule
    for _, x := range x {
        if x[2] > 0 {
            rules = append(rules,
                rule{pat: rs[x[2]:x[3]], term: x[4] > 0, rep: rs[x[6]:x[7]]})
        }
    }
    return rules, true
}

func run(rules []rule, s string) string {
step1:
    for _, r := range rules {
        if f := strings.Index(s, r.pat); f >= 0 {
            s = s[:f] + r.rep + s[f+len(r.pat):]
            if r.term {
                return s
            }
            goto step1
        }
    }
    return s
}

// text all cut and paste from RC task page
var testSet = []testCase{
    {`# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
A -> apple
B -> bag
S -> shop
T -> the
the shop -> my brother
a never used -> .terminating rule
`,
        `I bought a B of As from T S.`,
        `I bought a bag of apples from my brother.`,
    },
    {`# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule
`,
        `I bought a B of As from T S.`,
        `I bought a bag of apples from T shop.`,
    },
    {`# BNF Syntax testing rules
A -> apple
WWWW -> with
Bgage -> ->.*
B -> bag
->.* -> money
W -> WW
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule
`,
        `I bought a B of As W my Bgage from T S.`,
        `I bought a bag of apples with my money from T shop.`,
    },
    {`### Unary Multiplication Engine, for testing Markov Algorithm implementations
### By Donal Fellows.
# Unary addition engine
_+1 -> _1+
1+1 -> 11+
# Pass for converting from the splitting of multiplication into ordinary
# addition
1! -> !1
,! -> !+
_! -> _
# Unary multiplication by duplicating left side, right side times
1*1 -> x,@y
1x -> xX
X, -> 1,1
X1 -> 1X
_x -> _X
,x -> ,X
y1 -> 1y
y_ -> _
# Next phase of applying
[email protected] -> x,@y
[email protected]_ -> @_
,@_ -> !_
++ -> +
# Termination cleanup for addition
_1 -> 1
1+_ -> 1
_+_ ->
`,
        `_1111*11111_`,
        `11111111111111111111`,
    },
    {`# Turing machine: three-state busy beaver
#
# state A, symbol 0 => write 1, move right, new state B
A0 -> 1B
# state A, symbol 1 => write 1, move left, new state C
0A1 -> C01
1A1 -> C11
# state B, symbol 0 => write 1, move left, new state A
0B0 -> A01
1B0 -> A11
# state B, symbol 1 => write 1, move right, new state B
B1 -> 1B
# state C, symbol 0 => write 1, move left, new state B
0C0 -> B01
1C0 -> B11
# state C, symbol 1 => write 1, move left, halt
0C1 -> H01
1C1 -> H11
`,
        `000000A000000`,
        `00011H1111000`,
    },
}


go =>
  println([fib_fun(I) : I in 1..10]),
  F1=fib_fun(2**10),
  println(f1=F1),
  nl.

table
fib_fun(0) = 0.
fib_fun(1) = 1.
fib_fun(N) = fib_fun(N-1) + fib_fun(N-2).


  ! 8             NB.  Built in factorial operator
40320


(defn factorial [x]
    (cond
        (< x 0) nil
        (= x 0) 1
        (* x (factorial (dec x)))))


def markovInterpreterFor = { rules ->
    def ruleMap = [:]
    rules.eachLine { line ->
        (line =~ /\s*(.+)\s->\s([.]?)(.+)\s*/).each { text, key, terminating, value ->
            if (key.startsWith('#')) { return }
            ruleMap[key] = [text: value, terminating: terminating]
        }
    }
    [interpret: { text ->
        def originalText = ''
        while (originalText != text) {
            originalText = text
            for (Map.Entry e : ruleMap.entrySet()) {
                if (text.indexOf(e.key) >= 0) {
                    text = text.replace(e.key, e.value.text)
                    if (e.value.terminating) {
                        return text
                    }
                    break
                }
            }
        }
        text
    }]
}


package programas;

import java.math.BigInteger;
import java.util.InputMismatchException;
import java.util.Scanner;

public class IterativeFactorial {

  public BigInteger factorial(BigInteger n) {
    if ( n == null ) {
      throw new IllegalArgumentException();
    }
    else if ( n.signum() == - 1 ) {
      // negative
      throw new IllegalArgumentException("Argument must be a non-negative integer");
    }
    else {
      BigInteger factorial = BigInteger.ONE;
      for ( BigInteger i = BigInteger.ONE; i.compareTo(n) < 1; i = i.add(BigInteger.ONE) ) {
        factorial = factorial.multiply(i);
      }
      return factorial;
    }
  }

  public static void main(String[] args) {
    Scanner scanner = new Scanner(System.in);
    BigInteger number, result;
    boolean error = false;
    System.out.println("FACTORIAL OF A NUMBER");
    do {
      System.out.println("Enter a number:");
      try {
        number = scanner.nextBigInteger();
        result = new IterativeFactorial().factorial(number);
        error = false;
        System.out.println("Factorial of " + number + ": " + result);
      }
      catch ( InputMismatchException e ) {
        error = true;
        scanner.nextLine();
      }

      catch ( IllegalArgumentException e ) {
        error = true;
        scanner.nextLine();
      }
    }
    while ( error );
    scanner.close();
  }

}


V target = Array(‘METHINKS IT IS LIKE A WEASEL’)
V alphabet = ‘ ABCDEFGHIJLKLMNOPQRSTUVWXYZ’
V p = 0.05
V c = 100

F neg_fitness(trial)
   R sum(zip(trial, :target).map((t, h) -> Int(t != h)))

F mutate(parent)
   R parent.map(ch -> (I random:() < :p {random:choice(:alphabet)} E ch))

V parent = (0 .< target.len).map(_ -> random:choice(:alphabet))
V i = 0
print((‘#3’.format(i))‘ ’parent.join(‘’))
L parent != target
   V copies = ((0 .< c).map(_ -> mutate(:parent)))
   parent = min(copies, key' x -> neg_fitness(x))
   print((‘#3’.format(i))‘ ’parent.join(‘’))
   i++


import Data.List (isPrefixOf)
import Data.Maybe (catMaybes)
import Control.Monad
import Text.ParserCombinators.Parsec
import System.IO
import System.Environment (getArgs)

main = do
   args <- getArgs
   unless (length args == 1) $
       fail "Please provide exactly one source file as an argument."
   let sourcePath = head args
   source <- readFile sourcePath
   input <- getContents
   case parse markovParser sourcePath source of
       Right rules -> putStr $ runMarkov rules input
       Left  err   -> hPutStrLn stderr $ "Parse error at " ++ show err

data Rule = Rule
   {from :: String, terminating :: Bool, to :: String}

markovParser :: Parser [Rule]
markovParser = liftM catMaybes $
    (comment <|> rule) `sepEndBy` many1 newline
  where comment = char '#' >> skipMany nonnl >> return Nothing
        rule = liftM Just $ liftM3 Rule
            (manyTill (nonnl <?> "pattern character") $ try arrow)
            (succeeds $ char '.')
            (many nonnl)
        arrow = ws >> string "->" >> ws <?> "whitespace-delimited arrow"
        nonnl = noneOf "\n"
        ws = many1 $ oneOf " \t"
        succeeds p = option False $ p >> return True

runMarkov :: [Rule] -> String -> String
runMarkov rules s = f rules s
  where f []                              s = s
        f (Rule from terminating to : rs) s = g "" s
          where g _      ""    = f rs s
                g before ahead@(a : as) = if from `isPrefixOf` ahead
                  then let new = reverse before ++ to ++ drop (length from) ahead
                       in if terminating then new else f rules new
                  else g (a : before) as


int
fibIter(int n) {
    int fibPrev, fib, i;
    if (n < 2) {
        return 1;
    }
    fibPrev = 0;
    fib = 1;
    for (i = 1; i < n; i++) {
        int oldFib = fib;
        fib += fibPrev;
        fibPrev = oldFib;
    }
    return fib;
}


function factorial(n) {
  //check our edge case
  if (n < 0) { throw "Number must be non-negative"; }

  var result = 1;
  //we skip zero and one since both are 1 and are identity
  while (n > 1) {
    result *= n;
    n--;
  }
  return result;
}


PROC FACTORIAL(ARG) U;
    BEGIN
    ITEM ARG U;
    ITEM TEMP U;
    TEMP = 1;
    FOR I:2 BY 1 WHILE I<=ARG;
        TEMP = TEMP*I;
    FACTORIAL = TEMP;
    END


MRATE:	equ	26	; Chance of mutation (MRATE/256)
COPIES:	equ	100	; Amount of copies to make
fname1:	equ	5Dh	; First filename on command line (used for RNG seed)
fname2:	equ	6Dh	; Second filename (also used for RNG seed)
	org	100h
	;;;	Make random seed from the two CP/M 'filenames'
	lxi	b,rnddat
	lxi	h,fname1
	xra	a
	call	seed	; First four bytes from fn1 make X
	call	seed	; Second four bytes from fn1 make A
	mvi	l,fname2
	call	seed	; First four bytes from fn2 make B
	call	seed	; Second four bytes from fn2 make C
	;;;	Create the first parent (random string)
	lxi	h,parent
	mvi	e,tgtsz-1
genchr:	call	rndchr	; Get random character
	mov	m,a	; Store it
	inx	h
	dcr	e
	jnz	genchr
	mvi	m,'$'	; CP/M string terminator
	;;;	Main loop
loop:	lxi	d,parent
	push	d
	call	puts	; Print current parent
	pop	h	; Calculate fitness
	call	fitnes
	xra	a	; If it is 0, all characters match,
	ora	d
	rz		; So we stop.
	lxi	h,kids	; Otherwise, set HL to start of children,
	mvi	a,0FFh	; Initialize maximum fitness value
	sta	maxfit
	mvi	a,COPIES	; Initialize copy counter
	sta	copies
	;;;	Make copies
copy:	push	h	; Store the place where the copy will go
	call	mutcpy	; Make a mutated copy of the parent
	pop	h	; Get the place where the copy went
	push	h	; But keep it on the stack
	call	fitnes	; Calculate the fitness of that copy
	pop	h	; Get place where copy went
	lda	maxfit	; Get current best fitness
	cmp	d	; Compare to fitness of current copy
	jc	next	; If it wasn't better, next copy
	shld	maxptr	; If it was better, store pointer
	mov	a,d
	sta	maxfit	; And new max fitness
next:	lxi	b,tgtsz	; Get place for next copy
	dad 	b
	xchg		; Keep in DE
	lxi	h,copies
	dcr	m	; Any copies left to make?
	xchg
	jnz	copy	; Then make another copy
	lhld	maxptr	; Otherwise, get location of copy with best fitness
	lxi	b,parent	; Make that the new parent
pcopy:	mov	a,m	; Get character from copy
	inx	h
	stax	b	; Store into location of parent
	inx	b
	cpi	'$'	; Check for string terminator
	jnz	pcopy	; If it isn't, copy next character
	jmp	loop	; Otherwise, mutate new parent
	;;;	Make a copy of the parent, mutate it, and store it at [HL].
mutcpy:	lxi	b,parent
mcloop:	ldax	b	; Get current character
	inx	b
	mov	m,a	; Write it to new location
	inx	h
	cpi	'$'	; Was it the string terminator?
	rz		; Then stop
	call	rand	; Otherwise, get random value
	cpi	MRATE	; Should we mutate this character?
	jnc	mcloop	; If not, just copy next character
	call	rndchr	; Otherwise, get a random character
	dcx	h	; And store it instead of the character we had
	mov	m,a
	inx	h
	jmp	mcloop
	;;;	Calculate fitness of candidate under [HL], fitness is
	;;;	returned in D. Fitness is "inverted", i.e. a fitness of 0
	;;;	means everything matches.
fitnes:	lxi	b,target
	lxi	d,tgtsz	; E=counter, D=fitness
floop:	dcr	e	; Done yet?
	rz		; If so, return.
	ldax	b	; Get target character
	inx	b
	cmp	m	; Compare to current character
	inx	h
	jz	floop	; If they match, don't do anything
	inr	d	; If they don't match, count this
	jmp	floop
	;;;	Generate a random uppercase letter, or a space
	;;;	Return in A, other registers preserved
rndchr:	call	rand	; Get a random value
	ani	31	; from 0 to 31
	cpi	28	; If 28 or higher,
	jnc	rndchr	; get another value
	adi	'A'	; Make uppercase letter
	cpi	'Z'+1	; If the result is 'Z' or lower,
	rc		; then return it,
	mvi	a,' '	; otherwise return a space
	ret
	;;;	Load 4 bytes from [HL] and use them, plus A, as part of seed
	;;;	in [BC]
seed:	mvi	e,4	; 4 bytes
sloop:	xra	m
	inx	h
	dcr	e
	jnz	sloop
	stax	b
	inx	b
	ret
	;;;	Random number generator using XABC algorithm
rand:	push	h
	lxi	h,rnddat
	inr	m	; X++
	mov	a,m	; X
	inx	h
	xra	m	; ^ C
	inx	h
	xra	m	; ^ A
	mov	m,a	; -> A
	inx	h
	add	m	; + B
	mov	m,a	; -> B
	rar		; >>1 (ish)
	dcx	h
	xra	m	; ^ A
	dcx	h
	add	m	; + C
	mov	m,a	; -> C
	pop	h
	ret
	;;;	Print string to console using CP/M, saving all registers
puts:	push	h
	push	d
	push	b
	push	psw
	mvi	c,9	; CP/M print string
	call	5
	lxi	d,nl	; Print a newline as well
	mvi	c,9
	call	5
	pop	b
	pop	d
	pop	h
	pop	psw
	ret
nl:	db	13,10,'$'
target:	db	'METHINKS IT IS LIKE A WEASEL$'
tgtsz:	equ	$-target
rnddat:	ds	4	; RNG state
copies:	ds	1	; Copies left to make
maxfit:	ds	1	; Best fitness seen
maxptr:	ds	2	; Pointer to copy with best fitness
parent:	equ	$	; Store current parent here
kids:	equ	$+tgtsz	; Store mutated copies here


procedure main(A)
    rules := loadRules(open(A[1],"r"))
    every write(line := !&input, " -> ",apply(rules, line))
end

record rule(pat, term, rep)

procedure loadRules(f)
    rules := []
    every !f ? if not ="#" then put(rules,
                    rule(1(trim(tab(find("->"))),move(2),tab(many(' \t'))),
                         (="."|&null), trim(tab(0))))
    return rules
end

procedure apply(rules, line)
    s := line
    repeat {
       s ?:= tab(find((r := !rules).pat)) || r.rep || (move(*r.pat),tab(0))
       if (s == line) | \r.term then return s else line := s
       }
end


.sub fib
  .param int n
  .local int nt
  .local int ft
  if n < 2 goto RETURNN
  nt = n - 1
  ft = fib( nt )
  dec nt
  nt = fib(nt)
  ft = ft + nt
  .return( ft )
RETURNN:
  .return( n )
  end
.end

.sub main :main
  .local int counter
  .local int f
  counter=0
LOOP:
  if counter > 20 goto DONE
  f = fib(counter)
  print f
  print "\n"
  inc counter
  goto LOOP
DONE:
  end
.end


DEFINE factorial == [0 =] [pop 1] [dup 1 - factorial *] ifte.


def fact:
  reduce range(1; .+1) as $i (1; . * $i);


	bits	16
	cpu	8086
MRATE:	equ	26		; Mutation rate (MRATE/256)
COPIES:	equ	100		; Amount of copies to make
gettim:	equ	02Ch		; MS-DOS get time function
pstr:	equ	9		; MS-DOS print string
section	.text
	org	100h
	;;;	Use MS-DOS time to set random seed
	mov	ah,gettim
	int	21h
	mov	[rnddat],cx
	mov	[rnddat+2],dx
	;;;	Make first parent (random characters)
	mov	di,parent
	mov	cx,target.size-1
getchr:	call	rndchr		; Get random character
	stosb			; Store in parent
	loop	getchr
	mov	al,'$'		; Write string terminator
	stosb
	;;;	Main loop.
loop:	mov	bx,parent	; Print current parent
	mov	dx,bx
	call	puts
	call	fitnes		; Check fitness
	test	cl,cl		; If zero, we're done
	jnz	nxmut		; If not, do another mutation
	ret			; Quit to DOS
nxmut:	mov	dl,0FFh		; DL = best fitness yet
	mov	di,kids		; Set DI to start of memory for children
	mov	ch,COPIES	; CH = amount of copies to make
	xor	bp,bp
	;;;	Make copy, mutate, and test fitness
copy:	mov	bx,di		; Let BX = where next copy will go
	call	mutcpy		; Make the copy (and adjust DI)
	call	fitnes		; Check fitness
	cmp	cl,dl		; Is it better than the previous best one?
	ja	next		; If not, just do the next one,
	mov	dl,cl		; Otherwise, this is now the best one
	lea	bp,[di-target.size]	; Store a pointer to it in BP
next:	dec	ch		; One copy less
	jnz	copy		; Make another copy if we need to
	mov	si,bp		; We're done, the best child becomes
	mov	di,parent	; the parent for the next generation
	mov	cx,target.size
	rep	movsb
	jmp	loop		; Next generation
	;;;	Make copy of parent, mutating as we go, and store at [DI]
mutcpy:	mov	si,parent
.loop:	lodsb			; Get byte from parent
	stosb			; Store in copy
	cmp	al,'$'		; Is it '$'?
	je	.out		; Then we're done
	call	rand		; Otherwise, should we mutate?
	cmp	al,MRATE
	ja	.loop		; If not, do next character
	call	rndchr		; But if so, get random character,
	mov	[di-1],al	; and overwrite the current character.
	jmp	.loop		; Then do the next character.
.out:	ret
	;;;	Get fitness of character in [BX]
fitnes:	mov	si,target
	xor	cl,cl		; Fitness
.loop:	lodsb			; Get target character
	cmp 	al,'$'		; Done?
	je	.out		; Then stop
	cmp	al,[bx]		; Equal to character under [BX]?
	lahf			; Keep flags
	inc	bx		; Increment BX
	sahf			; Restore flags (was al=[bx]?)
	je	.loop		; If equal, do next character
	inc	cx		; Otherwise, count this as a mismatch
	jmp	.loop
.out:	ret
	;;;	Generate random character, [A-Z] or space.
rndchr:	call	rand		; Get random number
	and	al,31		; Lower five bits
	cmp	al,27		; One of 27 characters?
	jae	rndchr		; If not, get new random number
	add	al,'A'		; Make uppercase letter
	cmp	al,'Z'		; More than 'Z'?
	jbe	.out		; If not, it's OK
	mov	al,' '		; Otherwise, give a space
.out:	ret
	;;;	Random number generator using XABC algorithm
	;;;	Returns random byte in AL
rand:	push	cx
	push	dx
	mov	cx,[rnddat]	; CH=X CL=A
	mov	dx,[rnddat+2]	; DH=B DL=C
	inc	ch		; X++
	xor	cl,ch		; A ^= X
	xor	cl,dl		; A ^= C
	add	dh,cl		; B += A
	mov	al,dh		; C' = B
	shr	al,1		; C' >>= 1
	xor	al,cl		; C' ^= A
	add	al,dl		; C' += C
	mov	dl,al		; C = C'
	mov	[rnddat],cx
	mov	[rnddat+2],dx
	pop	dx
	pop	cx
	ret
	;;;	Print string in DX, plus a newline, saving registers
puts:	push	ax
	push	dx
	mov	ah,pstr
	int	21h
	mov	dx,nl
	int	21h
	pop	dx
	pop	ax
	ret
section	.data
nl:	db	13,10,'$'
target:	db	'METHINKS IT IS LIKE A WEASEL$'
.size:	equ	$-target
section	.bss
rnddat:	resb	4		; RNG state
parent:	resb	target.size	; Place to store current parent
kids:	resb	COPIES*target.size	; Place to store children


require'strings regex'

markovLexer =:  verb define
  rules =.  LF cut TAB&=`(,:&' ')}y
  rules =.  a: -.~ ([email protected]:{.~ i:&'#')&.> rules
  rules =.  0 _1 {"1 '\s+->\s+' (rxmatch rxcut ])S:0 rules
  (,. ] (}.&.>~ ,. ]) ('.'={.)&.>)/ |: rules
)

replace     =:  dyad define
  'index patternLength replacement'=.  x
  'head tail' =.  index split y
  head, replacement, patternLength }. tail
)

matches     =:  E. i. 1:

markov      =:  dyad define
  ruleIdx =. 0 [ rules =.  markovLexer x
  while. ruleIdx < #rules do.
    'pattern replacement terminating' =. ruleIdx { rules
    ruleIdx =. 1 + ruleIdx
    if. (#y) > index =. pattern matches y do.
      y =. (index ; (#pattern) ; replacement) replace y
      ruleIdx =. _ * terminating
    end.
  end.
  y
)


import java.io.IOException;
import java.nio.charset.StandardCharsets;
import java.nio.file.Files;
import java.nio.file.Paths;
import java.util.ArrayList;
import java.util.List;
import java.util.regex.Matcher;
import java.util.regex.Pattern;

public class Markov {

    public static void main(String[] args) throws IOException {

        List<String[]> rules = readRules("markov_rules.txt");
        List<String> tests = readTests("markov_tests.txt");

        Pattern pattern = Pattern.compile("^([^#]*?)\\s+->\\s+(\\.?)(.*)");

        for (int i = 0; i < tests.size(); i++) {
            String origTest = tests.get(i);

            List<String[]> captures = new ArrayList<>();
            for (String rule : rules.get(i)) {
                Matcher m = pattern.matcher(rule);
                if (m.find()) {
                    String[] groups = new String[m.groupCount()];
                    for (int j = 0; j < groups.length; j++)
                        groups[j] = m.group(j + 1);
                    captures.add(groups);
                }
            }

            String test = origTest;
            String copy = test;
            for (int j = 0; j < captures.size(); j++) {
                String[] c = captures.get(j);
                test = test.replace(c[0], c[2]);
                if (c[1].equals("."))
                    break;
                if (!test.equals(copy)) {
                    j = -1; // redo loop
                    copy = test;
                }
            }
            System.out.printf("%s\n%s\n\n", origTest, test);
        }
    }

    private static List<String> readTests(String path)
            throws IOException {
        return Files.readAllLines(Paths.get(path), StandardCharsets.UTF_8);
    }

    private static List<String[]> readRules(String path)
            throws IOException {
        String ls = System.lineSeparator();
        String lines = new String(Files.readAllBytes(Paths.get(path)), "UTF-8");
        List<String[]> rules = new ArrayList<>();
        for (String line : lines.split(ls + ls))
            rules.add(line.split(ls));
        return rules;
    }
}


/* Form the n-th Fibonacci number, n > 1.    12 March 2022 */
Fib: procedure (n) returns (fixed binary (31));
   declare (i, n, f1, f2, f3) fixed binary (31);

   f1 = 0; f2 = 1;
   do i = 1 to n-2;
      f3 = f1 + f2;
      f1 = f2;
      f2 = f3;
   end;
   return (f3);

end Fib;


/* Factorial, in Jsish */

/* recursive */
function fact(n) { return ((n < 2) ? 1 : n * fact(n - 1)); }

/* iterative */
function factorial(n:number) {
    if (n < 0) throw format("factorial undefined for negative values: %d", n);

    var fac = 1;
    while (n > 1) fac *= n--;
    return fac;
}

if (Interp.conf('unitTest') > 0) {
;fact(18);
;fact(1);

;factorial(18);
;factorial(42);
try { factorial(-1); } catch (err) { puts(err); }
}


with Ada.Long_Complex_Text_IO; use Ada.Long_Complex_Text_IO;
with Ada.Numerics; use Ada.Numerics;
with Ada.Numerics.Long_Complex_Types; use Ada.Numerics.Long_Complex_Types;
with Ada.Numerics.Long_Complex_Elementary_Functions; use Ada.Numerics.Long_Complex_Elementary_Functions;
procedure Eulers_Identity is
begin
   Put (Exp (Pi * i) + 1.0);
end Eulers_Identity;


BEGIN
    # calculate an approximation to e^(i pi) + 1 which should be 0 (Euler's identity) #

    # returns e^ix for long real x, using the series:                                 #
    #      exp(ix) = 1 - x^2/2! + x^4/4! - ... + i(x - x^3/3! + x^5/5! - x^7/7! ... ) #
    #      the expansion stops when successive terms differ by less than 1e-15        #
    PROC expi = ( LONG REAL x )LONG COMPL:
         BEGIN
            LONG REAL t              := 1;
            LONG REAL real part      := 1;
            LONG REAL imaginary part := 0;
            LONG REAL divisor        := 1;
            BOOL      even power     := FALSE;
            BOOL      subtract       := FALSE;
            LONG REAL diff           := 1;
            FOR n FROM 1 WHILE ABS diff > 1e-15 DO
                divisor *:= n;
                t       *:= x;
                LONG REAL term := t / divisor;
                IF even power THEN
                    # this term is real #
                    subtract := NOT subtract;
                    LONG REAL prev := real part;
                    IF subtract THEN
                        real part -:= term
                    ELSE
                        real part +:= term
                    FI;
                    diff := prev - real part
                ELSE
                    # this term is imaginary #
                    LONG REAL prev := imaginary part;
                    IF subtract THEN
                        imaginary part -:= term
                    ELSE
                        imaginary part +:= term
                    FI;
                    diff := prev - imaginary part
                FI;
                even power := NOT even power
            OD;
            ( real part, imaginary part )
         END # expi # ;
    LONG COMPL eulers identity = expi( long pi ) + 1;
    print( ( "e^(i*pi) + 1 ~ "
           , fixed( re OF eulers identity, -23, 20 )
           , " "
           , fixed( im OF eulers identity,  23, 20 )
           , "i"
           , newline
           )
         )
END


\ RosettaCode challenge http://rosettacode.org/wiki/Evolutionary_algorithm
\ Responding to the criticism that the implementation was too directed, this
\ version does a completely random selection of chars to mutate

var gen
\ Convert a string of valid chars into an array of char-strings:
"ABCDEFGHIJKLMNOPQRSTUVWXYZ " null s:/ var, valid-chars

\ How many mutations each generation will handle; the larger, the slower each
\ generation but the fewer generations required:
300 var, #mutations
23 var, mutability

: get-random-char
  valid-chars @
  27 rand-pcg n:abs swap n:mod
  a:@ nip ;

: mutate-string \ s -- s'
  (
    rand-pcg mutability @ n:mod not if
     drop get-random-char
    then
  ) s:map ;

: mutate \ s n -- a
  \ iterate 'n' times over the initial string, mutating it each time
  \ save the original string, as the best of the previous generation:
  >r [] over a:push swap
  (
  tuck mutate-string
  a:push swap
  ) r> times drop ;

\ compute Hamming distance of two strings:
: hamming \ s1 s2 -- n
  0 >r
  s:len n:1-
  (
   2 pick over s:@ nip
   2 pick rot s:@ nip
   n:- n:abs r> n:+ >r
  ) 0 rot loop
  2drop r> ;

var best
: fitness-check \ s a -- s t
  10000 >r
  -1 best !
  (
   \ ix s ix s'
    2 pick hamming
   [email protected]
   over n:> if
      rdrop >r
      best !
   else
      2drop
   then
  )
  a:each
  rdrop best @  a:@ nip  ;

: add-random-char \ s -- s'
  get-random-char s:+ ;

\ take the target and make a random string of the same length
: initial-string \ s -- s
  s:len "" swap
  ' add-random-char
  swap times ;

: done? \ s1 s2 -- s1 s2 | bye
  2dup s:= if
   "Done in " . gen @ . " generations" . cr ;;;
  then ;

: setup-random
  rand rand rand-pcg-seed ;

: evolve
  1 gen n:+!
  \ create an array of #mutations strings mutated from the random string, drop the random
  #mutations @ mutate
  \ iterate over the array and pick the closest fit:
  fitness-check
  \ show this generation's best match:
  dup . cr
  \ check for end condition and continue if not done:
  done? evolve ;

"METHINKS IT IS LIKE A WEASEL"
setup-random initial-string evolve bye


with Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
with Ada.Numerics.Float_Random;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;

procedure Evolution is

   -- only upper case characters allowed, and space, which uses '@' in
   -- internal representation (allowing subtype of Character).
   subtype DNA_Char is Character range '@' .. 'Z';

   -- DNA string is as long as target string.
   subtype DNA_String is String (1 .. 28);

   -- target string translated to DNA_Char string
   Target : constant DNA_String := "[email protected]@[email protected]@[email protected]";

   -- calculate the 'closeness' to the target DNA.
   -- it returns a number >= 0 that describes how many chars are correct.
   -- can be improved much to make evolution better, but keep simple for
   -- this example.
   function Fitness (DNA : DNA_String) return Natural is
      Result : Natural := 0;
   begin
      for Position in DNA'Range loop
         if DNA (Position) = Target (Position) then
            Result := Result + 1;
         end if;
      end loop;
      return Result;
   end Fitness;

   -- output the DNA using the mapping
   procedure Output_DNA (DNA : DNA_String; Prefix : String := "") is
      use Ada.Strings.Maps;
      Output_Map : Character_Mapping;
   begin
      Output_Map := To_Mapping
        (From => To_Sequence (To_Set (('@'))),
         To   => To_Sequence (To_Set ((' '))));
      Ada.Text_IO.Put (Prefix);
      Ada.Text_IO.Put (Ada.Strings.Fixed.Translate (DNA, Output_Map));
      Ada.Text_IO.Put_Line (", fitness: " & Integer'Image (Fitness (DNA)));
   end Output_DNA;

   -- DNA_Char is a discrete type, use Ada RNG
   package Random_Char is new Ada.Numerics.Discrete_Random (DNA_Char);
   DNA_Generator : Random_Char.Generator;

   -- need generator for floating type, too
   Float_Generator : Ada.Numerics.Float_Random.Generator;

   -- returns a mutated copy of the parent, applying the given mutation rate
   function Mutate (Parent        : DNA_String;
                    Mutation_Rate : Float)
                    return          DNA_String
   is
      Result : DNA_String := Parent;
   begin
      for Position in Result'Range loop
         if Ada.Numerics.Float_Random.Random (Float_Generator) <= Mutation_Rate
         then
            Result (Position) := Random_Char.Random (DNA_Generator);
         end if;
      end loop;
      return Result;
   end Mutate;

   -- genetic algorithm to evolve the string
   -- could be made a function returning the final string
   procedure Evolve (Child_Count   : Positive := 100;
                     Mutation_Rate : Float    := 0.2)
   is
      type Child_Array is array (1 .. Child_Count) of DNA_String;

      -- determine the fittest of the candidates
      function Fittest (Candidates : Child_Array) return DNA_String is
         The_Fittest : DNA_String := Candidates (1);
      begin
         for Candidate in Candidates'Range loop
            if Fitness (Candidates (Candidate)) > Fitness (The_Fittest)
            then
               The_Fittest := Candidates (Candidate);
            end if;
         end loop;
         return The_Fittest;
      end Fittest;

      Parent, Next_Parent : DNA_String;
      Children            : Child_Array;
      Loop_Counter        : Positive := 1;
   begin
      -- initialize Parent
      for Position in Parent'Range loop
         Parent (Position) := Random_Char.Random (DNA_Generator);
      end loop;
      Output_DNA (Parent, "First: ");
      while Parent /= Target loop
         -- mutation loop
         for Child in Children'Range loop
            Children (Child) := Mutate (Parent, Mutation_Rate);
         end loop;
         Next_Parent := Fittest (Children);
         -- don't allow weaker children as the parent
         if Fitness (Next_Parent) > Fitness (Parent) then
            Parent := Next_Parent;
         end if;
         -- output every 20th generation
         if Loop_Counter mod 20 = 0 then
            Output_DNA (Parent, Integer'Image (Loop_Counter) & ": ");
         end if;
         Loop_Counter := Loop_Counter + 1;
      end loop;
      Output_DNA (Parent, "Final (" & Integer'Image (Loop_Counter) & "): ");
   end Evolve;

begin
   -- initialize the random number generators
   Random_Char.Reset (DNA_Generator);
   Ada.Numerics.Float_Random.Reset (Float_Generator);
   -- evolve!
   Evolve;
end Evolution;


/**
 * Take a ruleset and return a function which takes a string to which the rules
 * should be applied.
 * @param {string} ruleSet
 * @returns {function(string): string}
 */
const markov = ruleSet => {

  /**
   * Split a string at an index
   * @param {string} s The string to split
   * @param {number} i The index number where to split.
   * @returns {Array<string>}
   */
  const splitAt = (s, i) => [s.slice(0, i), s.slice(i)];

  /**
   * Strip a leading number of chars from a string.
   * @param {string} s The string to strip the chars from
   * @param {string} strip A string who's length will determine the number of
   *    chars to strip.
   * @returns {string}
   */
  const stripLeading = (s, strip) => s.split('')
      .filter((e, i) => i >= strip.length).join('');

  /**
   * Replace the substring in the string.
   * @param {string} s The string to replace the substring in
   * @param {string} find The sub-string to find
   * @param {string} rep The replacement string
   * @returns {string}
   */
  const replace = (s, find, rep) => {
    let result = s;
    if (s.indexOf(find) >= 0) {
      const a = splitAt(s, s.indexOf(find));
      result = [a[0], rep, stripLeading(a[1], find)].join('');
    }
    return result;
  };

  /**
   * Convert a ruleset string into a map
   * @param {string} ruleset
   * @returns {Map}
   */
  const makeRuleMap = ruleset => ruleset.split('\n')
      .filter(e => !e.startsWith('#'))
      .map(e => e.split(' -> '))
      .reduce((p,c) => p.set(c[0], c[1]), new Map());

  /**
   * Recursively apply the ruleset to the string.
   * @param {Map} rules The rules to apply
   * @param {string} s The string to apply the rules to
   * @returns {string}
   */
  const parse = (rules, s) => {
    const o = s;
    for (const [k, v] of rules.entries()) {
      if (v.startsWith('.')) {
        s = replace(s, k, stripLeading(v, '.'));
        break;
      } else {
        s = replace(s, k, v);
        if (s !== o) { break; }
      }
    }
    return o === s ? s : parse(rules, s);
  };

  const ruleMap = makeRuleMap(ruleSet);

  return str => parse(ruleMap, str)
};

const ruleset1 = `# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
A -> apple
B -> bag
S -> shop
T -> the
the shop -> my brother
a never used -> .terminating rule`;

const ruleset2 = `# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule`;

const ruleset3 = `# BNF Syntax testing rules
A -> apple
WWWW -> with
Bgage -> ->.*
B -> bag
->.* -> money
W -> WW
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule`;

const ruleset4 = `### Unary Multiplication Engine, for testing Markov Algorithm implementations
### By Donal Fellows.
# Unary addition engine
_+1 -> _1+
1+1 -> 11+
# Pass for converting from the splitting of multiplication into ordinary
# addition
1! -> !1
,! -> !+
_! -> _
# Unary multiplication by duplicating left side, right side times
1*1 -> x,@y
1x -> xX
X, -> 1,1
X1 -> 1X
_x -> _X
,x -> ,X
y1 -> 1y
y_ -> _
# Next phase of applying
1@1 -> x,@y
1@_ -> @_
,@_ -> !_
++ -> +
# Termination cleanup for addition
_1 -> 1
1+_ -> 1
_+_ -> `;

const ruleset5 = `# Turing machine: three-state busy beaver
#
# state A, symbol 0 => write 1, move right, new state B
A0 -> 1B
# state A, symbol 1 => write 1, move left, new state C
0A1 -> C01
1A1 -> C11
# state B, symbol 0 => write 1, move left, new state A
0B0 -> A01
1B0 -> A11
# state B, symbol 1 => write 1, move right, new state B
B1 -> 1B
# state C, symbol 0 => write 1, move left, new state B
0C0 -> B01
1C0 -> B11
# state C, symbol 1 => write 1, move left, halt
0C1 -> H01
1C1 -> H11`;

console.log(markov(ruleset1)('I bought a B of As from T S.'));
console.log(markov(ruleset2)('I bought a B of As from T S.'));
console.log(markov(ruleset3)('I bought a B of As W my Bgage from T S.'));
console.log(markov(ruleset4)('_1111*11111_'));
console.log(markov(ruleset5)('000000A000000'));


F is_even(i)
   R i % 2 == 0

F is_odd(i)
   R i % 2 == 1


        .lf  evenodd6502.lst
        .cr  6502
        .tf  evenodd6502.obj,ap1
;------------------------------------------------------
; Even or Odd for the 6502 by barrym95838 2014.12.10
; Thanks to sbprojects.com for a very nice assembler!
; The target for this assembly is an Apple II with
;   mixed-case output capabilities.  Apple IIs like to
;   work in '+128' ascii, and this version is tailored
;   to that preference.
; Tested and verified on AppleWin 1.20.0.0
;------------------------------------------------------
; Constant Section
;
CharIn   =   $fd0c      ;Specific to the Apple II
CharOut  =   $fded      ;Specific to the Apple II
;------------------------------------------------------
; The main program
;
main    ldy  #sIntro-sbase
        jsr  puts       ;Print Intro
loop    jsr  CharIn     ;Get a char from stdin
        cmp  #$83       ;Ctrl-C?
        beq  done       ;  yes:  end program
        jsr  CharOut    ;Echo char
        ldy  #sOdd-sbase ;Pre-load odd string
        lsr             ;LSB of char to carry flag
        bcs  isodd
        ldy  #sEven-sbase
isodd   jsr  puts       ;Print appropriate response
        beq  loop       ;Always taken
; Output NUL-terminated string @ offset Y
;
puts    lda  sbase,y    ;Get string char
        beq  done       ;Done if NUL
        jsr  CharOut    ;Output the char
        iny             ;Point to next char
        bne  puts       ;Loop up to 255 times
done    rts             ;Return to caller
;------------------------------------------------------
; String Constants (in '+128' ascii, Apple II style)
;
sbase:                  ;String base address
sIntro  .az     -"Hit any key (Ctrl-C to quit):",-#13
sEven   .az     -" is even.",-#13
sOdd    .az     -" is odd.",-#13
;------------------------------------------------------
        .en


100H:
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;

PRINT$NUMBER: PROCEDURE (N);
    DECLARE S (6) BYTE INITIAL ('.....$');
    DECLARE (N, P) ADDRESS, C BASED P BYTE;
    P = .S(5);
DIGIT:
    P = P - 1;
    C = N MOD 10 + '0';
    N = N / 10;
    IF N > 0 THEN GO TO DIGIT;
    CALL PRINT(P);
END PRINT$NUMBER;

FIBONACCI: PROCEDURE (N) ADDRESS;
    DECLARE (N, A, B, C, I) ADDRESS;
    IF N<=1 THEN RETURN N;
    A = 0;
    B = 1;
    DO I=2 TO N;
        C = A;
        A = B;
        B = A + C;
    END;
    RETURN B;
END FIBONACCI;

DECLARE I ADDRESS;
DO I=0 TO 20;
    CALL PRINT$NUMBER(FIBONACCI(I));
    CALL PRINT(.' $');
END;
CALL EXIT;
EOF


help?> factorial
search: factorial Factorization factorize

  factorial(n)

  Factorial of n. If n is an Integer, the factorial is computed as an integer (promoted to at
  least 64 bits). Note that this may overflow if n is not small, but you can use factorial(big(n))
  to compute the result exactly in arbitrary precision. If n is not an Integer, factorial(n) is
  equivalent to gamma(n+1).

  julia> factorial(6)
  720

  julia> factorial(21)
  ERROR: OverflowError()
  [...]

  julia> factorial(21.0)
  5.109094217170944e19

  julia> factorial(big(21))
  51090942171709440000


#include <stdio.h>
#include <math.h>
#include <complex.h>
#include <wchar.h>
#include <locale.h>

int main() {
    wchar_t pi = L'\u03c0'; /* Small pi symbol */
    wchar_t ae = L'\u2245'; /* Approximately equals symbol */
    double complex e = cexp(M_PI * I) + 1.0;
    setlocale(LC_CTYPE, "");
    printf("e ^ %lci + 1 = [%.16f, %.16f] %lc 0\n", pi, creal(e), cimag(e), ae);
    return 0;
}


using System;
using System.Numerics;

public class Program
{
    static void Main() {
        Complex e = Math.E;
        Complex i = Complex.ImaginaryOne;
        Complex π = Math.PI;
        Console.WriteLine(Complex.Pow(e, i * π) + 1);
    }
}


#include <iostream>
#include <complex>

int main() {
  std::cout << std::exp(std::complex<double>(0.0, M_PI)) + 1.0 << std::endl;
  return 0;
}


program Euler_identity;

{$APPTYPE CONSOLE}

uses
  System.VarCmplx;

begin
  var result := VarComplexExp(Pi * VarComplexCreate(0, 1)) + 1;
  writeln(result);
  readln;
end.


integer
fitness(data t, data b)
{
    integer c, f, i;

    f = 0;

    for (i, c in b) {
        f += sign(t[i] ^ c);
    }

    f;
}

void
mutate(data e, data b, data u)
{
    integer c;

    for (, c in b) {
        e.append(drand(15) ? c : u[drand(26)]);
    }
}

integer
main(void)
{
    data b, t, u;
    integer f, i;

    t = "METHINK IT IS LIKE A WEASEL";
    u = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";

    i = ~t;
    while (i) {
        i -= 1;
        b.append(u[drand(26)]);
    }

    f = fitness(t, b);
    while (f) {
        data n;
        integer a;

        o_form("/lw4/~\n", f, b);

        n = b;

        i = 32;
        while (i) {
            data c;

            i -= 1;
            mutate(c, b, u);
            a = fitness(t, c);
            if (a < f) {
                f = a;
                n = c;
            }
        }

        b = n;
    }

    o_form("/lw4/~\n", f, b);

    return 0;
}


STRING target := "METHINKS IT IS LIKE A WEASEL";

PROC fitness = (STRING tstrg)REAL:
(
   INT sum := 0;
   FOR i FROM LWB tstrg TO UPB tstrg DO
      sum +:= ABS(ABS target[i] - ABS tstrg[i])
   OD;
   # fitness := # 100.0*exp(-sum/10.0)
);

PROC rand char = CHAR:
(
   #STATIC# []CHAR ucchars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
   # rand char := # ucchars[ENTIER (random*UPB ucchars)+1]
);

PROC mutate = (REF STRING kid, parent, REAL mutate rate)VOID:
(
   FOR i FROM LWB parent TO UPB parent DO
      kid[i] := IF random < mutate rate THEN rand char ELSE parent[i] FI
   OD
);

PROC kewe = ( STRING parent, INT iters, REAL fits, REAL mrate)VOID:
(
   printf(($"#"4d" fitness: "g(-6,2)"% "g(-6,4)" '"g"'"l$, iters, fits, mrate, parent))
);

PROC evolve = VOID:
(
   FLEX[UPB target]CHAR parent;
   REAL fits;
   [100]FLEX[UPB target]CHAR kid;
   INT iters := 0;
   kid[LWB kid] := LOC[UPB target]CHAR;
   REAL mutate rate;

   #  initialize  #
   FOR i FROM LWB parent TO UPB parent DO
      parent[i] := rand char
   OD;

   fits := fitness(parent);
   WHILE fits < 100.0 DO
      INT j;
      REAL kf;
      mutate rate := 1.0  - exp(- (100.0 - fits)/400.0);
      FOR j FROM LWB kid TO UPB kid DO
         mutate(kid[j], parent, mutate rate)
      OD;
      FOR j FROM LWB kid TO UPB kid DO
         kf := fitness(kid[j]);
         IF fits < kf THEN
            fits := kf;
            parent := kid[j]
         FI
      OD;
      IF iters MOD 100 = 0 THEN
         kewe( parent, iters, fits, mutate rate )
      FI;
      iters+:=1
   OD;
   kewe( parent, iters, fits, mutate rate )
);

main:
(
   evolve
)


jq -nrR --rawfile markov_rules markov_rules.txt -f program.jq markov_tests.txt


module MarkovAlgos

struct MarkovRule{F,T}
    patt::F
    repl::T
    term::Bool
end

isterminating(r::MarkovRule) = r.term
Base.show(io::IO, rule::MarkovRule) =
    print(io, rule.patt, " → ", isterminating(rule) ? "." : "", rule.repl)
function Base.convert(::Type{MarkovRule}, s::AbstractString)
    rmatch = match(r"^(.+)\s+->\s*(\.)?(.*)?$", s)
    if rmatch ≡ nothing || isempty(rmatch.captures)
        throw(ParseError("not valid rule: " * s))
    end
    patt, term, repl = rmatch.captures
    return MarkovRule(patt, repl ≢ nothing ? repl : "", term ≢ nothing)
end

function ruleset(file::Union{AbstractString,IO})
    ruleset = Vector{MarkovRule}(0)
    for line in eachline(file)
        ismatch(r"(^#|^\s*$)", line) || push!(ruleset, MarkovRule(line))
    end
    return ruleset
end

apply(text::AbstractString, rule::MarkovRule) = replace(text, rule.patt, rule.repl)
function apply(file::Union{AbstractString,IO}, ruleset::AbstractVector{<:MarkovRule})
    text = readstring(file)
    redo = !isempty(text)
    while redo
        matchrule = false
        for rule in ruleset
            if contains(text, rule.patt)
                matchrule = true
                text = apply(text, rule)
                redo = !isterminating(rule)
                break
            end
        end
        redo = redo && matchrule
    end
    return text
end

end  # module MarkovAlgos


// version 1.1.51

import java.io.File
import java.util.regex.Pattern

/* rulesets assumed to be separated by a blank line in file */
fun readRules(path: String): List<List<String>> {
    val ls = System.lineSeparator()
    return File(path).readText().split("$ls$ls").map { it.split(ls) }
}

/* tests assumed to be on consecutive lines */
fun readTests(path: String) = File(path).readLines()

fun main(args: Array<String>) {
    val rules = readRules("markov_rules.txt")
    val tests = readTests("markov_tests.txt")
    val pattern = Pattern.compile("^([^#]*?)\\s+->\\s+(\\.?)(.*)")

    for ((i, origTest) in tests.withIndex()) {
        val captures = mutableListOf<List<String>>()
        for (rule in rules[i]) {
            val m = pattern.matcher(rule)
            if (m.find()) {
                val groups = List<String>(m.groupCount()) { m.group(it + 1) }
                captures.add(groups)
            }
        }
        var test = origTest

        do {
            val copy = test
            var redo = false
            for (c in captures) {
                test = test.replace(c[0], c[2])
                if (c[1] == ".") break
                if (test != copy) { redo = true; break }
            }
        }
        while (redo)

        println("$origTest\n$test\n")
    }
}


CMDLIN:	equ	80h		; Location of CP/M command line argument
puts:	equ	9h		; Syscall to print a string
	;;;	Check if number given on command line is even or odd
	org	100h
	lxi	h,CMDLIN	; Find length of argument
	mov	a,m
	add	l		; Look up last character (digit)
	mov	l,a
	mov	a,m		; Retrieve low digit
	rar			; Rotate low bit into carry flag
	mvi	c,puts		; Prepare to print string
	lxi	d,odd		; If carry is set, then the number is odd
	jc	5		; So print 'odd'
	lxi	d,even		; Otherwise, the number is even
	jmp 	5		; So print 'even'
even:	db	'Even$'		; Strings
odd:	db	'Odd$'


CREATE OR REPLACE FUNCTION fib(n INTEGER) RETURNS INTEGER AS $$
BEGIN
  IF (n < 2) THEN
    RETURN n;
  END IF;
  RETURN fib(n - 1) + fib(n - 2);
END;
$$ LANGUAGE plpgsql;


{ recursive }
:factorial
    dup 1 great (
    [dup 1 - factorial *]
    [drop 1]
    ) if
;

{ iterative }
:factorial2
    1 swap [*] for
;

( 0 22 ) [
    "Factorial(" print dup print ") = " print factorial2 print nl
] for

" " input


    factRecursive::{:[x>1;x*.f(x-1);1]}
    factIterative::{*/1+!x}


USING: math math.constants math.functions prettyprint ;
1 e pi C{ 0 1 } * ^ + .


." e^(i*π) + 1 = " pi fcos 1e0 f+ f. '+ emit space pi fsin fs. 'i emit cr
bye


program euler
    use iso_fortran_env, only: output_unit, REAL64
    implicit none

    integer, parameter              :: d=REAL64
    real(kind=d), parameter         :: e=exp(1._d), pi=4._d*atan(1._d)
    complex(kind=d), parameter      :: i=(0._d,1._d)

    write(output_unit,*) e**(pi*i) + 1
end program euler