2 people like it.

Mini SNOBOL Interpreter

Minimal SNOBOL abstract syntax tree (AST), interpreter and internal DSL (but no parser), just enough to run some simple samples from Wikipedia's SNOBOL page: http://en.wikipedia.org/wiki/SNOBOL and most of the pattern matching examples from the SNOBOL 4 Tutorial http://www.snobol4.org/docs/burks/tutorial/ch4.htm

Abstract Syntax Tree

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
type label = string
type name = string
type arithmetic = Add | Subtract | Multiply | Divide | Power
type value = 
   | String of string 
   | Integer of int
   | Pattern of pattern
and expression = 
   | Value of value
   | Variable of name
   | Arithmetic of expression * arithmetic * expression
and pattern =
   | Expression of expression
   | And of pattern list
   | Or of pattern list
   | ConditionalAssignment of pattern * name
   //----------------------------
   // Primitive Patterns
   | Rem
   | Arb
   // Integer Pattern Functions
   | Len of expression
   | Pos of expression
   | RPos of expression
   | Tab of expression
   | RTab of expression
   // Character Pattern Functions
   | Any of expression
   | NotAny of expression
   | Span of expression
   | Break of expression   
type transferOn = Success | Failure | Goto
type transfer = { On:transferOn; Goto:label }
type command =
   | Assign of name * expression list
   | Match of expression list * pattern
   | Unit
type line = {
    Label : label option
    Command : command
    Transfer : transfer option
    }

Environment

1: 
2: 
3: 
4: 
5: 
6: 
type environment = {
   Subject:string;   
   Cursor:int;
   Actions:(unit->unit) list
   Result:value;
   Success:bool }

Built-in Functions

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
let rem env =
   let result = env.Subject.Substring(env.Cursor)
   seq [{ env with Result=String result; Cursor=env.Subject.Length-1 }]
let arb env =
   seq {
      for n in 0..env.Subject.Length-env.Cursor ->                    
         let result = env.Subject.Substring(env.Cursor,n)
         {env with Cursor=env.Cursor+n; Result=String result }
   }
let len env n =
   if n > env.Subject.Length + env.Cursor then 
      seq [{ env with Success=false }]
   else
      let result = env.Subject.Substring(env.Cursor,n)
      seq [{ env with Cursor=env.Cursor+n; Result=String result }]
let pos env n =
   if n = env.Cursor then seq [env]
   else seq [{ env with Success=false }]
let rpos env n =
   if n = env.Subject.Length - env.Cursor then seq [env]
   else seq [{ env with Success=false }]
let tab env n =
   if n >= env.Cursor && n < env.Subject.Length then
      let result = env.Subject.Substring(env.Cursor, n - env.Cursor)
      seq [{env with Result=String result; Cursor=n }]
   else seq [{ env with Success=false }]
let rtab env n =
   if (env.Subject.Length - env.Cursor) >= n then
      let length = env.Subject.Length - env.Cursor - n
      let result = env.Subject.Substring(env.Cursor, length)
      seq [{env with Result=String result; Cursor=env.Subject.Length-n }]
   else seq [{ env with Success=false }]
let any env (s:string) =  
   let c = env.Subject.Chars(env.Cursor)   
   if s |> String.exists ((=)c) then
      seq [{ env with Cursor=env.Cursor+1; Result=String(c.ToString()) }]
   else
      seq [{ env with Success=false }]
let notany env (s:string) =
   let c = env.Subject.Chars(env.Cursor)   
   if not(s |> String.exists ((=)c)) then
      seq [{ env with Cursor=env.Cursor+1; Result=String(c.ToString()) }]
   else
      seq [{ env with Success=false }]
let span env (s:string) =    
   let mutable n = 0
   while let c = env.Subject.Chars(env.Cursor+n) in 
         (s |> String.exists ((=)(c))) do n <- n + 1
   if n > 0 
   then
      let result = env.Subject.Substring(env.Cursor,n)
      seq [{ env with Cursor=env.Cursor+n; Result=String result }]
   else seq [{ env with Success=false }]
let ``break`` env s =
   let mutable n = 0
   while let c = env.Subject.Chars(env.Cursor+n) in 
         (s |> String.exists ((<>)(c))) do n <- n + 1  
   let result = env.Subject.Substring(env.Cursor,n)
   seq [{ env with Cursor=env.Cursor+n; Result=String result }]   

Interpereter

  1: 
  2: 
  3: 
  4: 
  5: 
  6: 
  7: 
  8: 
  9: 
 10: 
 11: 
 12: 
 13: 
 14: 
 15: 
 16: 
 17: 
 18: 
 19: 
 20: 
 21: 
 22: 
 23: 
 24: 
 25: 
 26: 
 27: 
 28: 
 29: 
 30: 
 31: 
 32: 
 33: 
 34: 
 35: 
 36: 
 37: 
 38: 
 39: 
 40: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
106: 
107: 
108: 
109: 
110: 
111: 
112: 
113: 
114: 
115: 
116: 
117: 
118: 
119: 
120: 
121: 
122: 
123: 
124: 
125: 
126: 
127: 
128: 
129: 
130: 
131: 
132: 
133: 
134: 
135: 
136: 
137: 
138: 
139: 
140: 
141: 
142: 
143: 
144: 
145: 
146: 
147: 
148: 
let (|AsInt|_|) s =
   match System.Int32.TryParse(s) with
   | true, n -> Some n
   | false, _ -> None
let toString = function 
   | String s -> s 
   | Integer n -> n.ToString()
   | Pattern _ -> invalidOp ""
let toInt = function
   | Integer n -> n
   | String(AsInt n) -> n
   | _ -> invalidOp ""
let run input output (lines:line list) =
   let variables = System.Collections.Generic.Dictionary<name, value>()
   let assign name value =
      match name, value with
      | "OUTPUT", Pattern(_) -> name |> output
      | "OUTPUT", _ -> value |> toString |> output
      | _, _ -> variables.[name] <- value
   let get name =
      match name with
      | "INPUT" -> input () |> String
      | _ -> variables.[name]
   let rec concat expressions =      
      System.String.Concat [for e in expressions -> evaluate e |> toString] |> String
   and evaluate expression =      
      match expression with
      | Value(value) -> value
      | Variable(name) -> get name
      | Arithmetic(lhs,op,rhs) ->
         match evaluate lhs, evaluate rhs with
         | Integer l, Integer r -> Integer(arithmetic op l r)
         | Integer l, String (AsInt r) -> Integer(arithmetic op l r)
         | _ -> invalidOp "Illegal data type"
   and arithmetic op l r =
      match op with
      | Add -> l + r
      | Subtract -> l - r
      | Multiply -> l * r
      | Divide -> l / r
      | Power -> pown l r
   and tryPattern (env:environment) pattern : environment seq =
      match pattern with
      | Expression(expression) ->
         let subject = env.Subject.Substring(env.Cursor)
         let value = evaluate expression
         match value with
         | Pattern pattern -> tryPattern env pattern
         | value ->  
            let value = value |> toString
            if subject.StartsWith(value)
            then
               let cursor = env.Cursor+value.Length
               let result = String value
               seq [{ env with Cursor=cursor; Result=result }]
            else 
               seq [{ env with Success = false }]
      | And(patterns) ->
         let rec applyPattern env = function
            | [] -> env
            | p::ps ->
               let newEnvs = tryPattern env p       
               let found =
                  newEnvs |> Seq.tryPick (fun newEnv ->
                     if newEnv.Success then                        
                        let env = applyPattern newEnv ps
                        if env.Success
                        then Some env
                        else None
                     else None
                  )
               match found with
               | Some newEnv -> 
                  let result = toString env.Result + toString newEnv.Result
                  { newEnv with Result = String result }
               | None -> {env with Success=false}
         seq [applyPattern env patterns]
      | Or(patterns) -> 
         let rec findPattern = function
            | [] -> seq [{ env with Success = false }]
            | p::ps ->
               let newEnvs = tryPattern env p
               match newEnvs |> Seq.tryFind (fun env -> env.Success) with
               | Some env -> seq [env] 
               | None -> findPattern ps
         findPattern patterns
      | ConditionalAssignment(pattern,subject) ->
         let envs = tryPattern env pattern
         seq {
            for env in envs -> 
               let onSuccess () = assign subject env.Result
               { env with Actions=onSuccess::env.Actions }
         }     
      // Built-in functions
      | Rem -> rem env
      | Arb -> arb env
      | Len(n) -> len env (evaluate n |> toInt)
      | Pos(n) -> pos env (evaluate n |> toInt)
      | RPos(n) -> rpos env (evaluate n |> toInt)
      | Tab(n) -> tab env (evaluate n |> toInt)
      | RTab(n) -> rtab env (evaluate n |> toInt)
      | Any(s) -> any env (evaluate s |> toString)
      | NotAny(s) -> notany env (evaluate s |> toString)
      | Span(s) -> span env (evaluate s |> toString)
      | Break(s) -> ``break`` env (evaluate s |> toString)
   let rec gotoLine i =
      let line = lines.[i]      
      let success =
         match line.Command with           
         | Assign(subject, expressions) ->             
            let value = 
               match expressions with
               | expression::[] -> evaluate expression
               | _ -> concat expressions
            assign subject value
            true
         | Match(subject, pattern) ->                        
            let subject = concat subject |> toString
            let env = { Subject=subject; Cursor=0; Result=String ""; Actions=[]; Success=true}
            let rec tryFromIndex n =
               if n = subject.Length then false
               else
                  let env = { env with Cursor=n }            
                  let found = tryPattern env pattern |> Seq.tryFind (fun env -> env.Success)
                  match found with
                  | None -> tryFromIndex (n+1)
                  | Some env ->
                     for action in env.Actions |> List.rev do action()
                     true                  
            tryFromIndex 0          
         | Unit -> true
      match line.Transfer with
      | None -> 
         if i < lines.Length-1 then gotoLine (i+1)
      | Some(transfer) ->
         let j = 
            lines 
            |> List.findIndex (fun line -> 
                  match line.Label with 
                  | Some label -> label = transfer.Goto 
                  | None -> false)                        
         match transfer.On, success with
         | Success, true -> gotoLine j
         | Failure, false -> gotoLine j
         | Goto, _ -> gotoLine j
         | _ when i < lines.Length-1 -> gotoLine (i+1)
         | _ -> ()         
   gotoLine 0

Hello World Example

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
(*
          OUTPUT = "Hello world"
*)
let input () = ""
let output = printfn "%s"
[{Label=None; Command=Assign("OUTPUT",[Value(String("Hello World"))]);Transfer=None}]
|> run input output
// > Hello World

Input Example

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
(*
          OUTPUT = "What is your name?"
          Username = INPUT
          OUTPUT = "Thank you, " Username
*)
[{Label=None; Command=Assign("OUTPUT",[Value(String("What is your name?"))]);Transfer=None}
 {Label=None; Command=Assign("Username",[Variable("INPUT")]);Transfer=None}
 {Label=None; Command=Assign("OUTPUT",[Value(String("Thank you, "));Variable("Username")]);
                                      Transfer=None}]
|> run (fun () -> "Doctor") output
// > What is your name?
// > Thank you, Doctor

Control Flow Example

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
(*
          OUTPUT = "What is your name?"
          Username = INPUT
          Username "Jay"                                           :S(LOVE)
          Username "Kay"                                           :S(HATE)
MEH       OUTPUT = "Hi, " Username                                 :(END)
LOVE      OUTPUT = "How nice to meet you, " Username               :(END)
HATE      OUTPUT = "Oh. It's you, " Username
END
*)
let program =
   [
   {Label=None; Command=Assign("OUTPUT",[Value(String("What is your name?"))]);Transfer=None}
   {Label=None; Command=Assign("Username",[Variable("INPUT")]);Transfer=None}
   {Label=None; Command=Match([Variable("Username")], Expression(Value(String "J")));
                Transfer=Some {On=Success;Goto="LOVE"}}
   {Label=None; Command=Match([Variable("Username")], Expression(Value(String "K")));
                Transfer=Some {On=Success;Goto="HATE"}}
   {Label=Some "MEH"; 
    Command=Assign("OUTPUT",[Value(String "Hi, ");Variable("Username")]);
    Transfer=Some {On=Success;Goto="END"}}
   {Label=Some "LOVE"; 
    Command=Assign("OUTPUT",[Value(String "How nice to meet you, ");Variable("Username")]);
    Transfer=Some {On=Success;Goto="END"}}
   {Label=Some "HATE"; 
    Command=Assign("OUTPUT",[Value(String "Oh. It's you, ");Variable("Username")]);
    Transfer=Some {On=Success;Goto="END"}}
   {Label=Some "END"; Command=Unit;Transfer=None}
   ]

program |> run (fun () -> "Jay") output
// > What is your name?
// > How nice to meet you, Jay
program |> run (fun () -> "Kay") output
// > What is your name?
// > Oh. It's you, Kay
program |> run (fun () -> "Bob") output
// > What is your name?
// > Hi, Bob

Input Loop Example

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
(*
          OUTPUT = "This program will ask you for personal names"
          OUTPUT = "until you press return without giving it one"
          NameCount = 0                                            :(GETINPUT)
AGAIN     NameCount = NameCount + 1
          OUTPUT = "Name " NameCount ": " PersonalName
GETINPUT  OUTPUT = "Please give me name " NameCount + 1 
          PersonalName = INPUT
          PersonalName LEN(1)                                      :S(AGAIN)
          OUTPUT = "Finished. " NameCount " names requested."
END
*)

let loop =
   [
   {Label=None; 
    Command=Assign("OUTPUT",[Value(String("This program will ask you for personal names"))]);
    Transfer=None}
   {Label=None; 
    Command=Assign("OUTPUT",[Value(String("until you press return without giving it one"))]);
    Transfer=None}
   {Label=None; 
    Command=Assign("NameCount",[Value(Integer(0))]);
    Transfer=Some {On=Goto;Goto="GETINPUT"}}
   {Label=Some "AGAIN"; 
    Command=Assign("NameCount",[Arithmetic(Variable("NameCount"),Add,Value(Integer(1)))]);
    Transfer=None}
   {Label=None; 
    Command=Assign("OUTPUT",[Value(String("Name ")); Variable("NameCount");
                             Value(String(": "));Variable("PersonalName")]);
    Transfer=None}      
   {Label=Some "GETINPUT"; Command=Assign("PersonalName",[Variable("INPUT")]); Transfer=None}
   {Label=None; 
    Command=Match([Variable("PersonalName")],Len(Value(Integer(1)))); 
    Transfer=Some {On=Success;Goto="AGAIN"}}
   {Label=None; 
    Command=Assign("OUTPUT", [Value(String("Finished. ")); Variable("NameCount");
                              Value(String(" names requested."))])
    Transfer=None}
   ]

let names () =
   let names = seq ["Billy"; "Bob"; "Thornton"]
   let e = names.GetEnumerator()
   fun () -> if e.MoveNext() then e.Current else ""
loop |> run (names ()) output
// > This program will ask you for personal names
// > until you press return without giving it one
// > Name 1: Billy
// > Name 2: Bob
// > Name 3: Thornton
// > Finished. 3 names requested.

Simple Pattern Matching Examples

  1: 
  2: 
  3: 
  4: 
  5: 
  6: 
  7: 
  8: 
  9: 
 10: 
 11: 
 12: 
 13: 
 14: 
 15: 
 16: 
 17: 
 18: 
 19: 
 20: 
 21: 
 22: 
 23: 
 24: 
 25: 
 26: 
 27: 
 28: 
 29: 
 30: 
 31: 
 32: 
 33: 
 34: 
 35: 
 36: 
 37: 
 38: 
 39: 
 40: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
106: 
107: 
108: 
109: 
110: 
111: 
112: 
113: 
114: 
115: 
116: 
117: 
118: 
119: 
120: 
121: 
122: 
123: 
124: 
125: 
126: 
127: 
128: 
129: 
130: 
131: 
132: 
133: 
134: 
135: 
136: 
137: 
138: 
139: 
140: 
141: 
142: 
143: 
144: 
145: 
146: 
147: 
148: 
149: 
150: 
151: 
152: 
153: 
154: 
155: 
156: 
157: 
158: 
159: 
160: 
161: 
162: 
163: 
164: 
165: 
166: 
167: 
168: 
169: 
170: 
171: 
172: 
173: 
174: 
175: 
176: 
177: 
178: 
179: 
180: 
181: 
182: 
183: 
184: 
185: 
186: 
187: 
188: 
189: 
190: 
191: 
192: 
193: 
194: 
195: 
196: 
197: 
198: 
199: 
200: 
201: 
202: 
203: 
204: 
205: 
206: 
207: 
208: 
209: 
210: 
211: 
212: 
213: 
214: 
215: 
216: 
217: 
218: 
219: 
220: 
221: 
222: 
223: 
224: 
225: 
226: 
227: 
228: 
229: 
230: 
231: 
232: 
233: 
234: 
235: 
236: 
237: 
238: 
239: 
240: 
241: 
(*
          'BLUEBIRD' 'BIRD' . OUTPUT
END
*)
let bird =
   [
   {Label=None; 
    Command=Match([Value(String("BLUEBIRD"))],
                   ConditionalAssignment(
                     Expression(Value(String("BIRD"))),
                     "OUTPUT")); 
    Transfer=None}
   ]

bird |> run input output
// > BIRD

(*
          B = 'BLUEBIRD'
          B ('BLUE' | 'GOLD') . OUTPUT
          G = 'GOLDFISH'
          B ('BLUE' | 'GOLD') . OUTPUT
          COLOR = 'BLUE' | 'GOLD'
          B COLOR . OUTPUT
END
*)
let color =
   [
   // B = 'BLUEBIRD'
   {Label=None; Command=Assign("B", [Value(String("BLUEBIRD"))]); Transfer=None}
   // B ('BLUE' | 'GOLD') . OUTPUT
   {Label=None; 
    Command=Match([Variable("B")],
                  ConditionalAssignment(
                     Or [Expression(Value(String("GOLD")));Expression(Value(String("BLUE")))],
                     "OUTPUT")); 
    Transfer=None}
   // G = 'GOLDFISH'
   {Label=None; Command=Assign("G", [Value(String("GOLDFISH"))]); Transfer=None}
   // B ('BLUE' | 'GOLD') . OUTPUT
   {Label=None; 
    Command=Match([Variable("G")],
                  ConditionalAssignment(
                     Or [Expression(Value(String("GOLD")));Expression(Value(String("BLUE")))],
                     "OUTPUT")); 
    Transfer=None}  
   // COLOR = 'BLUE' | 'GOLD'
   {Label=None; 
    Command=Assign("COLOR",
                   [Value(Pattern(Or [Expression(Value(String("GOLD")));
                                      Expression(Value(String("BLUE")))]))]); 
    Transfer=None}
   // B COLOR . OUTPUT
   {Label=None; 
    Command=Match([Variable("B")],
                  ConditionalAssignment(Expression(Variable("COLOR")), "OUTPUT")); 
    Transfer=None}  
   ]

color |> run input output
// > BLUE
// > GOLD
// > BLUE

(*
          'B2' ('A' | 'B') . OUTPUT (1 | 2 | 3) . OUTPUT
*)
let b2 = 
   [
   {Label=None; 
    Command=Match([Value(String("B2"))],
                  And [
                     ConditionalAssignment(
                        Or[Expression(Value(String "A"));
                           Expression(Value(String "B"))],
                        "OUTPUT")
                     ConditionalAssignment(
                        Or[Expression(Value(String "1"));
                           Expression(Value(String "2"));
                           Expression(Value(String "3"))],
                        "OUTPUT")
                  ]); 
    Transfer=None}
   ]

b2 |> run input output
// > B
// > 2

(*
          'THE WINTER WINDS' 'WIN' REM . OUTPUT
*)
let winter = 
   [
   {Label=None; 
    Command=Match([Value(String("THE WINTER WINDS"))],
                  And [Expression(Value(String("WIN")));
                       ConditionalAssignment(Rem,"OUTPUT")]); 
    Transfer=None}
   ]

winter |> run input output
// > TER WINDS

(*
          'MOUNTAIN' 'O' ARB . OUTPUT 'A'
          'MOUNTAIN' 'O' ARB . OUTPUT 'U'
*)
let mountain = 
   [
   {Label=None; 
    Command=Match([Value(String("MOUNTAIN"))],
                  And [Expression(Value(String("O")));
                       ConditionalAssignment(Arb,"OUTPUT");
                       Expression(Value(String("A")))]); 
    Transfer=None}
   {Label=None; 
    Command=Match([Value(String("MOUNTAIN"))],
                  And [Expression(Value(String("O")));
                       ConditionalAssignment(Arb,"OUTPUT");
                       Expression(Value(String("U")))]); 
    Transfer=None}
   ]

mountain |> run input output
// > UNT
// >

(*
          S = 'ABCDA'
          S LEN(3) . OUTPUT RPOS(0)
          S POS(3) LEN(1) . OUTPUT
*)
let abcda =
   [
   {Label=None; Command=Assign("S", [Value(String("ABCDA"))]); Transfer=None}
   {Label=None; 
    Command=Match([Variable("S")],
                  And [ConditionalAssignment(Len(Value(Integer(3))),"OUTPUT");
                       RPos(Value(Integer(0)))]); 
    Transfer=None}
   {Label=None; 
    Command=Match([Variable("S")],
                  And [Pos(Value(Integer(3)))
                       ConditionalAssignment(Len(Value(Integer(1))),"OUTPUT")]); 
    Transfer=None}
   ]

abcda |> run input output
// > CDA
// > D

(*
          'ABCDE' TAB(2) . OUTPUT
          'ABCDE' TAB(2) . OUTPUT RTAB(1) . OUTPUT REM . OUTPUT
*)

let abcde =
   [
   {Label=None; 
    Command=Match([Value(String("ABCDE"))], 
                   And(
                     [ConditionalAssignment(Tab(Value(Integer(2))),"OUTPUT");
                      ConditionalAssignment(RTab(Value(Integer(1))),"OUTPUT");
                      ConditionalAssignment(Rem,"OUTPUT")]));
    Transfer=None}    
   ]

abcde |> run input output
// > AB
// > CD
// > E

(*
          VOWEL = ANY('AEIOU')          
          DVOWEL = VOWEL VOWEL
          NOTVOWEL = NOTANY('AEIOU')
          'VACUUM' VOWEL . OUTPUT
          'VACUUM' DVOWEL . OUTPUT
          'VACUUM' (VOWEL NOTVOWEL) . OUTPUT
*)

let vacuum =
   [
   {Label=None; Command=Assign("VOWELS", [Value(String("AEIOU"))]); Transfer=None}
   {Label=None; 
    Command=Assign("VOWEL", [Value(Pattern(Any(Variable("VOWELS"))))]); 
    Transfer=None}
   {Label=None; 
    Command=Assign("DVOWEL", 
                   [Value(
                     Pattern(
                        And [Expression(Variable("VOWEL"));
                             Expression(Variable("VOWEL"))])
                    )]);                                       
    Transfer=None}
   {Label=None; 
    Command=Assign("NOTVOWEL", [Value(Pattern(NotAny(Variable("VOWELS"))))]); 
    Transfer=None}
   {Label=None; 
    Command=Match([Value(String("VACUUM"))],
                  ConditionalAssignment(Expression(Variable("VOWEL")),"OUTPUT"));
    Transfer=None}
   {Label=None; 
    Command=Match([Value(String("VACUUM"))],
                  ConditionalAssignment(Expression(Variable("DVOWEL")),"OUTPUT"));
    Transfer=None}
   {Label=None; 
    Command=Match([Value(String("VACUUM"))],
                  ConditionalAssignment(
                     And [Expression(Variable("VOWEL"));
                          Expression(Variable("NOTVOWEL"))],
                     "OUTPUT"));                       
    Transfer=None}
   ]

vacuum |> run input output
// > A
// > UU
// > AC

(*
          LETTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ'-"
          WORD = SPAN(LETTERS)
          GAP = BREAK(LETTERS)
          'SAMPLE LINE' WORD . OUTPUT
*)

let word =
   [
   {Label=None; 
    Command=Assign("LETTERS", [Value(String("ABCDEFGHIJKLMNOPQRSTUVWXYZ'-"))]); 
    Transfer=None}
   {Label=None; 
    Command=Match([Value(String("SAMPLE LINE"))],                    
                  ConditionalAssignment(Span(Variable("LETTERS")),"OUTPUT"));
    Transfer=None}    
   ]

word |> run input output
// > SAMPLE
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
type name = string

Full name: Script.name
type arithmetic =
  | Add
  | Subtract
  | Multiply
  | Divide
  | Power

Full name: Script.arithmetic
union case arithmetic.Add: arithmetic
union case arithmetic.Subtract: arithmetic
union case arithmetic.Multiply: arithmetic
union case arithmetic.Divide: arithmetic
union case arithmetic.Power: arithmetic
type value =
  | String of string
  | Integer of int
  | Pattern of pattern

Full name: Script.value
Multiple items
union case value.String: string -> value

--------------------
module String

from Microsoft.FSharp.Core
union case value.Integer: int -> value
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
union case value.Pattern: pattern -> value
type pattern =
  | Expression of expression
  | And of pattern list
  | Or of pattern list
  | ConditionalAssignment of pattern * name
  | Rem
  | Arb
  | Len of expression
  | Pos of expression
  | RPos of expression
  | Tab of expression
  ...

Full name: Script.pattern
type expression =
  | Value of value
  | Variable of name
  | Arithmetic of expression * arithmetic * expression

Full name: Script.expression
union case expression.Value: value -> expression
union case expression.Variable: name -> expression
union case expression.Arithmetic: expression * arithmetic * expression -> expression
union case pattern.Expression: expression -> pattern
union case pattern.And: pattern list -> pattern
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
union case pattern.Or: pattern list -> pattern
union case pattern.ConditionalAssignment: pattern * name -> pattern
union case pattern.Rem: pattern
union case pattern.Arb: pattern
union case pattern.Len: expression -> pattern
union case pattern.Pos: expression -> pattern
union case pattern.RPos: expression -> pattern
union case pattern.Tab: expression -> pattern
union case pattern.RTab: expression -> pattern
union case pattern.Any: expression -> pattern
union case pattern.NotAny: expression -> pattern
union case pattern.Span: expression -> pattern
union case pattern.Break: expression -> pattern
type transferOn =
  | Success
  | Failure
  | Goto

Full name: Script.transferOn
union case transferOn.Success: transferOn
Multiple items
union case transferOn.Failure: transferOn

--------------------
active recognizer Failure: exn -> string option

Full name: Microsoft.FSharp.Core.Operators.( |Failure|_| )
union case transferOn.Goto: transferOn
type transfer =
  {On: transferOn;
   Goto: label;}

Full name: Script.transfer
transfer.On: transferOn
transfer.Goto: label
type label = string

Full name: Script.label
type command =
  | Assign of name * expression list
  | Match of expression list * pattern
  | Unit

Full name: Script.command
union case command.Assign: name * expression list -> command
union case command.Match: expression list * pattern -> command
union case command.Unit: command
type line =
  {Label: label option;
   Command: command;
   Transfer: transfer option;}

Full name: Script.line
line.Label: label option
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>
line.Command: command
line.Transfer: transfer option
type environment =
  {Subject: string;
   Cursor: int;
   Actions: (unit -> unit) list;
   Result: value;
   Success: bool;}

Full name: Script.environment
environment.Subject: string
environment.Cursor: int
environment.Actions: (unit -> unit) list
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
environment.Result: value
environment.Success: bool
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
val rem : env:environment -> seq<environment>

Full name: Script.rem
val env : environment
val result : string
System.String.Substring(startIndex: int) : string
System.String.Substring(startIndex: int, length: int) : string
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Core.Operators.seq

--------------------
type seq<'T> = System.Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
property System.String.Length: int
val arb : env:environment -> seq<environment>

Full name: Script.arb
val n : int
val len : env:environment -> n:int -> seq<environment>

Full name: Script.len
val pos : env:environment -> n:int -> seq<environment>

Full name: Script.pos
val rpos : env:environment -> n:int -> seq<environment>

Full name: Script.rpos
val tab : env:environment -> n:int -> seq<environment>

Full name: Script.tab
val rtab : env:environment -> n:int -> seq<environment>

Full name: Script.rtab
val length : int
val any : env:environment -> s:string -> seq<environment>

Full name: Script.any
val s : string
val c : char
property System.String.Chars: int -> char
val exists : predicate:(char -> bool) -> str:string -> bool

Full name: Microsoft.FSharp.Core.String.exists
System.Char.ToString() : string
System.Char.ToString(provider: System.IFormatProvider) : string
val notany : env:environment -> s:string -> seq<environment>

Full name: Script.notany
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
val span : env:environment -> s:string -> seq<environment>

Full name: Script.span
val mutable n : int
namespace System
type Int32 =
  struct
    member CompareTo : value:obj -> int + 1 overload
    member Equals : obj:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member GetTypeCode : unit -> TypeCode
    member ToString : unit -> string + 3 overloads
    static val MaxValue : int
    static val MinValue : int
    static member Parse : s:string -> int + 3 overloads
    static member TryParse : s:string * result:int -> bool + 1 overload
  end

Full name: System.Int32
System.Int32.TryParse(s: string, result: byref<int>) : bool
System.Int32.TryParse(s: string, style: System.Globalization.NumberStyles, provider: System.IFormatProvider, result: byref<int>) : bool
union case Option.Some: Value: 'T -> Option<'T>
union case Option.None: Option<'T>
val toString : _arg1:value -> string

Full name: Script.toString
System.Int32.ToString() : string
System.Int32.ToString(provider: System.IFormatProvider) : string
System.Int32.ToString(format: string) : string
System.Int32.ToString(format: string, provider: System.IFormatProvider) : string
val invalidOp : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.invalidOp
val toInt : _arg1:value -> int

Full name: Script.toInt
active recognizer AsInt: string -> int option

Full name: Script.( |AsInt|_| )
val run : input:(unit -> string) -> output:(string -> unit) -> lines:line list -> unit

Full name: Script.run
val input : (unit -> string)
val output : (string -> unit)
val lines : line list
val variables : System.Collections.Generic.Dictionary<name,value>
namespace System.Collections
namespace System.Collections.Generic
Multiple items
type Dictionary<'TKey,'TValue> =
  new : unit -> Dictionary<'TKey, 'TValue> + 5 overloads
  member Add : key:'TKey * value:'TValue -> unit
  member Clear : unit -> unit
  member Comparer : IEqualityComparer<'TKey>
  member ContainsKey : key:'TKey -> bool
  member ContainsValue : value:'TValue -> bool
  member Count : int
  member GetEnumerator : unit -> Enumerator<'TKey, 'TValue>
  member GetObjectData : info:SerializationInfo * context:StreamingContext -> unit
  member Item : 'TKey -> 'TValue with get, set
  ...
  nested type Enumerator
  nested type KeyCollection
  nested type ValueCollection

Full name: System.Collections.Generic.Dictionary<_,_>

--------------------
System.Collections.Generic.Dictionary() : unit
System.Collections.Generic.Dictionary(capacity: int) : unit
System.Collections.Generic.Dictionary(comparer: System.Collections.Generic.IEqualityComparer<'TKey>) : unit
System.Collections.Generic.Dictionary(dictionary: System.Collections.Generic.IDictionary<'TKey,'TValue>) : unit
System.Collections.Generic.Dictionary(capacity: int, comparer: System.Collections.Generic.IEqualityComparer<'TKey>) : unit
System.Collections.Generic.Dictionary(dictionary: System.Collections.Generic.IDictionary<'TKey,'TValue>, comparer: System.Collections.Generic.IEqualityComparer<'TKey>) : unit
val assign : (string -> value -> unit)
Multiple items
val name : string

--------------------
type name = string

Full name: Script.name
Multiple items
val value : value

--------------------
type value =
  | String of string
  | Integer of int
  | Pattern of pattern

Full name: Script.value
val get : (string -> value)
val concat : (seq<expression> -> value)
val expressions : seq<expression>
Multiple items
type String =
  new : value:char -> string + 7 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 2 overloads
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  member GetHashCode : unit -> int
  ...

Full name: System.String

--------------------
System.String(value: nativeptr<char>) : unit
System.String(value: nativeptr<sbyte>) : unit
System.String(value: char []) : unit
System.String(c: char, count: int) : unit
System.String(value: nativeptr<char>, startIndex: int, length: int) : unit
System.String(value: nativeptr<sbyte>, startIndex: int, length: int) : unit
System.String(value: char [], startIndex: int, length: int) : unit
System.String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: System.Text.Encoding) : unit
System.String.Concat([<System.ParamArray>] values: string []) : string
   (+0 other overloads)
System.String.Concat(values: System.Collections.Generic.IEnumerable<string>) : string
   (+0 other overloads)
System.String.Concat<'T>(values: System.Collections.Generic.IEnumerable<'T>) : string
   (+0 other overloads)
System.String.Concat([<System.ParamArray>] args: obj []) : string
   (+0 other overloads)
System.String.Concat(arg0: obj) : string
   (+0 other overloads)
System.String.Concat(str0: string, str1: string) : string
   (+0 other overloads)
System.String.Concat(arg0: obj, arg1: obj) : string
   (+0 other overloads)
System.String.Concat(str0: string, str1: string, str2: string) : string
   (+0 other overloads)
System.String.Concat(arg0: obj, arg1: obj, arg2: obj) : string
   (+0 other overloads)
System.String.Concat(str0: string, str1: string, str2: string, str3: string) : string
   (+0 other overloads)
val e : expression
val evaluate : (expression -> value)
Multiple items
val expression : expression

--------------------
type expression =
  | Value of value
  | Variable of name
  | Arithmetic of expression * arithmetic * expression

Full name: Script.expression
Multiple items
val name : name

--------------------
type name = string

Full name: Script.name
val lhs : expression
val op : arithmetic
val rhs : expression
val l : int
val r : int
Multiple items
val arithmetic : (arithmetic -> int -> int -> int)

--------------------
type arithmetic =
  | Add
  | Subtract
  | Multiply
  | Divide
  | Power

Full name: Script.arithmetic
val pown : x:'T -> n:int -> 'T (requires member get_One and member ( * ) and member ( / ))

Full name: Microsoft.FSharp.Core.Operators.pown
val tryPattern : (environment -> pattern -> seq<environment>)
Multiple items
val pattern : pattern

--------------------
type pattern =
  | Expression of expression
  | And of pattern list
  | Or of pattern list
  | ConditionalAssignment of pattern * name
  | Rem
  | Arb
  | Len of expression
  | Pos of expression
  | RPos of expression
  | Tab of expression
  ...

Full name: Script.pattern
val subject : string
Multiple items
val value : string

--------------------
type value =
  | String of string
  | Integer of int
  | Pattern of pattern

Full name: Script.value
System.String.StartsWith(value: string) : bool
System.String.StartsWith(value: string, comparisonType: System.StringComparison) : bool
System.String.StartsWith(value: string, ignoreCase: bool, culture: System.Globalization.CultureInfo) : bool
val cursor : int
val result : value
val patterns : pattern list
val applyPattern : (environment -> pattern list -> environment)
val p : pattern
val ps : pattern list
val newEnvs : seq<environment>
val found : environment option
module Seq

from Microsoft.FSharp.Collections
val tryPick : chooser:('T -> 'U option) -> source:seq<'T> -> 'U option

Full name: Microsoft.FSharp.Collections.Seq.tryPick
val newEnv : environment
val findPattern : (pattern list -> seq<environment>)
val tryFind : predicate:('T -> bool) -> source:seq<'T> -> 'T option

Full name: Microsoft.FSharp.Collections.Seq.tryFind
val subject : name
val envs : seq<environment>
val onSuccess : (unit -> unit)
val n : expression
val s : expression
val gotoLine : (int -> unit)
val i : int
Multiple items
val line : line

--------------------
type line =
  {Label: label option;
   Command: command;
   Transfer: transfer option;}

Full name: Script.line
val success : bool
val expressions : expression list
val subject : expression list
val tryFromIndex : (int -> bool)
val action : (unit -> unit)
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val rev : list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.rev
property List.Length: int
Multiple items
val transfer : transfer

--------------------
type transfer =
  {On: transferOn;
   Goto: label;}

Full name: Script.transfer
val j : int
val findIndex : predicate:('T -> bool) -> list:'T list -> int

Full name: Microsoft.FSharp.Collections.List.findIndex
Multiple items
val label : label

--------------------
type label = string

Full name: Script.label
union case transferOn.Failure: transferOn
val input : unit -> string

Full name: Script.input
val output : (string -> unit)

Full name: Script.output
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val program : line list

Full name: Script.program
val loop : line list

Full name: Script.loop
val names : unit -> (unit -> string)

Full name: Script.names
val names : seq<string>
val e : System.Collections.Generic.IEnumerator<string>
System.Collections.Generic.IEnumerable.GetEnumerator() : System.Collections.Generic.IEnumerator<string>
System.Collections.IEnumerator.MoveNext() : bool
property System.Collections.Generic.IEnumerator.Current: string
val bird : line list

Full name: Script.bird
val color : line list

Full name: Script.color
val b2 : line list

Full name: Script.b2
val winter : line list

Full name: Script.winter
val mountain : line list

Full name: Script.mountain
val abcda : line list

Full name: Script.abcda
val abcde : line list

Full name: Script.abcde
val vacuum : line list

Full name: Script.vacuum
val word : line list

Full name: Script.word

More information

Link:http://fssnip.net/oV
Posted:10 years ago
Author:Phillip Trelford
Tags: snobol , language , ast , interpreter