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: 

type value = String of string | Integer of int
type label = string
type subject = string
type expression = 
   | Literal of value
   | Variable of subject
   | Concat of expression * expression
type transferOn = Success | Failure | Any
type transfer = { On:transferOn; Goto:label }
type command =
   | Assign of subject * expression
   | Match of expression * expression
   | Unit
type line = {
    Label : label option
    Command : command
    Transfer : transfer option
    }

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: 

let toString = function | String s -> s | Integer n -> n.ToString()
let variables = System.Collections.Generic.Dictionary<subject, value>()
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(lhs,rhs) ->
         match evaluate lhs, evaluate rhs with
         | String l, String r -> String(l+r)
         | Integer l, Integer r -> Integer(l+r)
         | _ -> invalidOp ""
   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(lhs, rhs) ->           
            evaluate lhs = evaluate rhs 
         | 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

Hello World

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

Input

 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

Control flow

 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 "Jay"));
                Transfer=Some {On=Success;Goto="LOVE"}}
   {Label=None; Command=Match(Variable("Username"),Literal(String "Kay"));
                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
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 subject = string

Full name: Script.subject
type expression =
  | Literal of value
  | Variable of subject
  | Concat of expression * expression

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: subject -> expression
union case expression.Concat: expression * expression -> 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 subject * expression
  | Match of expression * expression
  | Unit

Full name: Script.command
union case command.Assign: subject * 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<subject,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
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
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val evaluate : (expression -> value)
Multiple items
val expression : expression

--------------------
type expression =
  | Literal of value
  | Variable of subject
  | Concat of expression * expression

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

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

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

--------------------
type subject = string

Full name: Script.subject
val lhs : expression
val rhs : expression
val l : string
val r : string
val l : int
val r : int
val invalidOp : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.invalidOp
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
union case Option.None: Option<'T>
property List.Length: int
union case Option.Some: Value: 'T -> Option<'T>
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
Next Version Raw view Test code New version

More information

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

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.