2 people like it.
Like the snippet!
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
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
|
type value = String of string | Integer of int
type label = string
type name = string
type arithmetic = Add | Subtract | Multiply | Divide | Power
type expression =
| Literal of value
| Variable of name
| Concat of expression list
| Arithmetic of expression * arithmetic * expression
| Len of int
type transferOn = Success | Failure | Any
type transfer = { On:transferOn; Goto:label }
type command =
| Assign of name * expression
| Match of expression * expression
| Unit
type line = {
Label : label option
Command : command
Transfer : transfer option
}
|
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:
|
let toString = function | String s -> s | Integer n -> n.ToString()
let variables = System.Collections.Generic.Dictionary<name, value>()
let (|AsInteger|_|) s =
match System.Int32.TryParse(s) with
| true, n -> Some n
| false, _ -> None
let run input output (lines:line list) =
let rec evaluate expression =
match expression with
| Literal(value) -> value
| Variable("INPUT") -> input () |> String
| Variable(subject) -> variables.[subject]
| Concat(expressions) ->
System.String.Concat([for e in expressions -> evaluate e |> toString])
|> String
| Arithmetic(lhs,op,rhs) ->
match evaluate lhs, evaluate rhs with
| Integer l, Integer r -> Integer(arithmetic op l r)
| Integer l, String (AsInteger r) -> Integer(arithmetic op l r)
| _ -> invalidOp "Illegal data type"
| Len(n) -> invalidOp ""
and arithmetic op l r =
match op with
| Add -> l + r
| Subtract -> l - r
| Multiply -> l * r
| Divide -> l / r
| Power -> pown l r
let rec nextLine i =
let line = lines.[i]
let result =
match line.Command with
| Assign("OUTPUT", expression) ->
evaluate expression |> toString |> output
true
| Assign(subject, expression) ->
let value = evaluate expression
variables.[subject] <- value
true
| Match(subject, Len(count)) ->
let s = evaluate subject |> toString
s.Length >= count
| Match(subject, pattern) ->
match evaluate subject, evaluate pattern with
| String subject, String pattern -> subject.Contains pattern
| Integer subject, Integer pattern -> subject = pattern
| _, _ -> invalidOp ""
| Unit -> true
match line.Transfer with
| None ->
if i < lines.Length-1 then nextLine (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, result with
| Success, true -> nextLine j
| Failure, false -> nextLine j
| Any, _ -> nextLine j
| _ when i < lines.Length-1 -> nextLine (i+1)
| _ -> ()
nextLine 0
|
1:
2:
3:
4:
5:
6:
7:
8:
|
(*
OUTPUT = "Hello world"
*)
let input () = ""
let output = printfn "%s"
[{Label=None; Command=Assign("OUTPUT",Literal(String("Hello World")));Transfer=None}]
|> run input output
// > Hello World
|
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",Literal(String("What is your name?")));Transfer=None}
{Label=None; Command=Assign("Username",Variable("INPUT"));Transfer=None}
{Label=None; Command=Assign("OUTPUT",Concat [Literal(String("Thank you, "));Variable("Username")]);
Transfer=None}]
|> run (fun () -> "Doctor") output
// > What is your name?
// > Thank you, Doctor
|
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",Literal(String("What is your name?")));Transfer=None}
{Label=None; Command=Assign("Username",Variable("INPUT"));Transfer=None}
{Label=None; Command=Match(Variable("Username"),Literal(String "J"));
Transfer=Some {On=Success;Goto="LOVE"}}
{Label=None; Command=Match(Variable("Username"),Literal(String "K"));
Transfer=Some {On=Success;Goto="HATE"}}
{Label=Some "MEH";
Command=Assign("OUTPUT",Concat [Literal(String "Hi, ");Variable("Username")]);
Transfer=Some {On=Success;Goto="END"}}
{Label=Some "LOVE";
Command=Assign("OUTPUT",Concat [Literal(String "How nice to meet you, ");Variable("Username")]);
Transfer=Some {On=Success;Goto="END"}}
{Label=Some "HATE";
Command=Assign("OUTPUT",Concat [Literal(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
|
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",Literal(String("This program will ask you for personal names")));
Transfer=None}
{Label=None;
Command=Assign("OUTPUT",Literal(String("until you press return without giving it one")));
Transfer=None}
{Label=None;
Command=Assign("NameCount",Literal(Integer(0)));
Transfer=Some {On=Any;Goto="GETINPUT"}}
{Label=Some "AGAIN";
Command=Assign("NameCount",Arithmetic(Variable("NameCount"),Add,Literal(Integer(1))));
Transfer=None}
{Label=None;
Command=Assign("OUTPUT",Concat [Literal(String("Name ")); Variable("NameCount");
Literal(String(": "));Variable("PersonalName")]);
Transfer=None}
{Label=Some "GETINPUT"; Command=Assign("PersonalName",Variable("INPUT")); Transfer=None}
{Label=None;
Command=Match(Variable("PersonalName"),Len(1));
Transfer=Some {On=Success;Goto="AGAIN"}}
{Label=None;
Command=Assign("OUTPUT", Concat [Literal(String("Finished. ")); Variable("NameCount");
Literal(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.
|
Multiple items
union case value.String: string -> value
--------------------
module String
from Microsoft.FSharp.Core
Multiple items
val string : value:'T -> string
Full name: Microsoft.FSharp.Core.Operators.string
--------------------
type string = System.String
Full name: Microsoft.FSharp.Core.string
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<_>
type label = string
Full name: Script.label
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 expression =
| Literal of value
| Variable of name
| Concat of expression list
| Arithmetic of expression * arithmetic * expression
| Len of int
Full name: Script.expression
Multiple items
union case expression.Literal: value -> expression
--------------------
type LiteralAttribute =
inherit Attribute
new : unit -> LiteralAttribute
Full name: Microsoft.FSharp.Core.LiteralAttribute
--------------------
new : unit -> LiteralAttribute
type value =
| String of string
| Integer of int
Full name: Script.value
union case expression.Variable: name -> expression
union case expression.Concat: expression list -> expression
type 'T list = List<'T>
Full name: Microsoft.FSharp.Collections.list<_>
union case expression.Arithmetic: expression * arithmetic * expression -> expression
union case expression.Len: int -> expression
type transferOn =
| Success
| Failure
| Any
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.Any: transferOn
type transfer =
{On: transferOn;
Goto: label;}
Full name: Script.transfer
transfer.On: transferOn
transfer.Goto: label
type command =
| Assign of name * expression
| Match of expression * expression
| Unit
Full name: Script.command
union case command.Assign: name * expression -> command
union case command.Match: expression * expression -> 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
val toString : _arg1:value -> string
Full name: Script.toString
val s : string
val n : int
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 variables : System.Collections.Generic.Dictionary<name,value>
Full name: Script.variables
namespace System
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
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 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 evaluate : (expression -> value)
Multiple items
val expression : expression
--------------------
type expression =
| Literal of value
| Variable of name
| Concat of expression list
| Arithmetic of expression * arithmetic * expression
| Len of int
Full name: Script.expression
Multiple items
val value : value
--------------------
type value =
| String of string
| Integer of int
Full name: Script.value
val subject : name
val expressions : expression list
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 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
active recognizer AsInteger: string -> int option
Full name: Script.( |AsInteger|_| )
val invalidOp : message:string -> 'T
Full name: Microsoft.FSharp.Core.Operators.invalidOp
val pown : x:'T -> n:int -> 'T (requires member get_One and member ( * ) and member ( / ))
Full name: Microsoft.FSharp.Core.Operators.pown
val nextLine : (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 result : bool
val subject : expression
val count : int
property System.String.Length: int
val pattern : expression
val subject : string
val pattern : string
val subject : int
val pattern : int
property List.Length: int
Multiple items
val transfer : transfer
--------------------
type transfer =
{On: transferOn;
Goto: label;}
Full name: Script.transfer
val j : int
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 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 -> string)
Full name: Script.names
val names : seq<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<_>
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
More information