2013-02-25 Write your own language

2013-02-25 write-your-own-language

# Title: Write your own language
# Author: Mikael Lundin
# Link: http://blog.mikaellundin.name/2013/02/25/write-your-own-language.html

invoker1.fs

module Invoker
 
open Lisp.Statements
open Microsoft.FSharp.Quotations
open Linq.QuotationEvaluation
open Microsoft.FSharp.Reflection
 
// functions that are callable from inside my lisp program
let framework =
    [
        "add", typeof<int -> int -> int>, <@@ (fun a b -> a + b) @@>;
        "sub", typeof<int -> int -> int>, <@@ (fun a b -> a - b) @@>;
        "eq", typeof<int -> int -> bool>, <@@ (fun (a : int) b -> a = b) @@>;
        "if", typeof<bool -> int -> int -> int>, <@@ (fun cond (yes : int) no -> if cond then yes else no) @@>
    ]
 
// Create an application
// Example: Application (Application (add, Value (1)), Value (2))
let application var args =
    args |> List.fold(fun prev next -> Quotations.Expr.Application(prev, next)) var
 
// convert ast to Quotations.Expr
let rec toExprUntyped vars = function
| Number(x)  -> Quotations.Expr.Value(x)
| Boolean(x) -> Quotations.Expr.Value(x)
| Call(name, arguments) ->
    // resolve arguments
    let argumentExpressions = arguments |> List.map (fun arg -> (toExprUntyped vars arg))
    // create application
    application (vars |> Map.find(name)) argumentExpressions
 
// typed version of toExprUntyped
let toExpr<'a> (vars : Map<string, Quotations.Expr>) ast : Quotations.Expr<'a> =
    (toExprUntyped vars ast) |> Quotations.Expr<'a>.Cast
 
// take name, function signature and body, create a var and let expression in a tuple
let create_fn (name, signature, lambda) =
    let var = Quotations.Var(name, signature)
    var, (fun (body : Quotations.Expr) -> Quotations.Expr.Let(var, lambda, body))
 
// make next let expression become body of the previous
let rec mergeLetExpressions<'a> (exprs : (Quotations.Expr -> Quotations.Expr) list) (body : Quotations.Expr<'a>) =
    match exprs with
    | [] -> body
    | hd :: tl -> hd(mergeLetExpressions tl body) |> Quotations.Expr<'a>.Cast
 
// execute ast
let invoke<'a> (framework : (string * System.Type * Quotations.Expr) list) ast =
    let vars, exprs = framework |> List.map create_fn |> List.unzip
    // create vars map
    let state = vars |> List.map (fun var -> var.Name, Quotations.Expr.Var(var)) |> Map.ofList
    // build expression tree from framework
    let header = (mergeLetExpressions<'a> exprs)
    // join framework expression tree with intepretated ast
    (header (toExpr<'a> state ast)).Eval()

invoker2.fs

module Invoker
 
open Lisp.Statements
open Microsoft.FSharp.Quotations
open Linq.QuotationEvaluation
open Microsoft.FSharp.Reflection
 
// functions that are callable from inside my lisp program
let framework =
    [
        "add", typeof<int -> int -> int>, <@@ (fun a b -> a + b) @@>;
        "sub", typeof<int -> int -> int>, <@@ (fun a b -> a - b) @@>;
        "eq", typeof<int -> int -> bool>, <@@ (fun (a : int) b -> a = b) @@>;
        "if", typeof<bool -> int -> int -> int>, <@@ (fun cond (yes : int) no -> if cond then yes else no) @@>;
        "lt", typeof<int -> int -> bool>, <@@ (fun (a : int) b -> a < b ) @@>
    ]
 
// convert ast to Quotations.Expr
let rec toExprUntyped vars = function
| Number(x) -> Quotations.Expr.Value(x)
| Boolean(x) -> Quotations.Expr.Value(x)
| Identifier(x) -> vars |> Map.find(x)
| Call(name, arguments) ->
    // resolve arguments
    let argumentExpressions = arguments |> List.map (fun arg -> (toExprUntyped vars arg))
    // create application
    argumentExpressions |> List.fold(fun prev next -> Quotations.Expr.Application(prev, next)) (vars |> Map.find(name))
 
// debug values
// let name = "myAdd"
// let parameters = [("x", typeof<int>); ("y", typeof<int>)]
// let bodyAst = Call ("add", [(Identifier "x"); (Identifier "y")])
| Defun(name, parameters, bodyAst, inscopeAst) ->
    // create function local variables (NOTE: locked into parameters as ints)
    let localVars = parameters |> List.map (fun param -> Quotations.Var(param, typeof<int>))
    // create function local variables expressions
    let localVarsExpr = localVars |> List.map (Quotations.Expr.Var)
    // create local scope
    let localScope = List.zip parameters localVarsExpr |> List.fold (fun scope (paramName, varExpr) -> scope |> Map.add paramName varExpr) vars
    // evaluate body
    let bodyExpr = toExprUntyped localScope bodyAst
    // create body lambda
    let lambdaExpr = localVars |> List.rev |> List.fold (fun expr var -> Quotations.Expr.Lambda(var, expr)) bodyExpr
    // create function handle
    let funcVar = Quotations.Var(name, lambdaExpr.Type)
    // create let expression
    let letExpr next = Quotations.Expr.Let(funcVar, lambdaExpr, next)
    // return evaluation of next, with this function in scope
    letExpr (toExprUntyped (vars.Add(name, Quotations.Expr.Var(funcVar))) inscopeAst)
 
| x -> failwith (sprintf "Unknown program construct %A" x)
 
// typed version of toExprUntyped
let toExpr<'a> (vars : Map<string, Quotations.Expr>) ast : Quotations.Expr<'a> =
    (toExprUntyped vars ast) |> Quotations.Expr<'a>.Cast
 
// take name, function signature and body, create a var and let expression in a tuple
let create_fn (name, signature, lambda) =
    let var = Quotations.Var(name, signature)
    var, (fun (body : Quotations.Expr) -> Quotations.Expr.Let(var, lambda, body))
 
// make next let expression become body of the previous
let rec mergeLetExpressions<'a> (exprs : (Quotations.Expr -> Quotations.Expr) list) (body : Quotations.Expr<'a>) =
    match exprs with
    | [] -> body
    | hd :: tl -> hd(mergeLetExpressions tl body) |> Quotations.Expr<'a>.Cast
 
// execute ast
let invoke<'a> (framework : (string * System.Type * Quotations.Expr) list) (ast : Ast) =
    let state, exprs = framework |> List.map create_fn |> List.unzip
    // create vars map
    let vars = state |> List.map (fun var -> var.Name, Quotations.Expr.Var(var)) |> Map.ofList
    // build expression tree from framework
    let header = (mergeLetExpressions<'a> exprs)
    // join framework expression tree with intepretated ast
    (header (toExpr<'a> vars ast)).Eval()

lexer1.fsl

{
module Lexer
open System
open Parser
open Microsoft.FSharp.Text.Lexing
}
 
let whitespace = [' ' '\n' '\r']
let digit = ['0'-'9']
let number = '-'?digit+
let boolean = "t" | "nil"
 
rule tokenize line = parse
| whitespace    { tokenize line lexbuf }
| number        { NUMBER (Int32.Parse(LexBuffer<_>.LexemeString lexbuf)) }
| boolean       { BOOLEAN((LexBuffer<_>.LexemeString lexbuf) = "t") }
| eof           { END }

lexer2.fsl

{
module Lexer
open System
open Parser
open Microsoft.FSharp.Text.Lexing
}
 
let whitespace = [' ' '\n' '\r']
let digit = ['0'-'9']
let number = '-'?digit+
let boolean = "t" | "nil"
let char = ['a'-'z' 'A'-'Z']
 
rule tokenize line = parse
| whitespace    { tokenize line lexbuf }
| number        { NUMBER (Int32.Parse(LexBuffer<_>.LexemeString lexbuf)) }
| boolean       { if (LexBuffer<_>.LexemeString lexbuf) = "t" then BOOLEAN(true) else BOOLEAN(false) }
| char+         { IDENTIFIER(LexBuffer<_>.LexemeString lexbuf) }
| "("           { LPAREN }
| ")"           { RPAREN }
| eof           { END }

lexer3.fsl

{
module Lexer
open System
open Parser
open Microsoft.FSharp.Text.Lexing
}
 
let whitespace = [' ' '\t']
let newline = ('\n' | '\r' '\n')
let digit = ['0'-'9']
let number = '-'?digit+
let boolean = "t" | "nil"
let char = ['a'-'z' 'A'-'Z']
 
rule tokenize line = parse
| whitespace    { tokenize line lexbuf }
| newline       { lexbuf.EndPos <- lexbuf.EndPos.NextLine; tokenize (line + 1) lexbuf; }
| "defun"       { DEFUN }
| number        { NUMBER (Int32.Parse(LexBuffer<_>.LexemeString lexbuf)) }
| boolean       { if (LexBuffer<_>.LexemeString lexbuf) = "t" then BOOLEAN(true) else BOOLEAN(false) }
| char+         { IDENTIFIER(LexBuffer<_>.LexemeString lexbuf) }
| "("           { LPAREN }
| ")"           { RPAREN }
| eof           { END }

parser1.fsy

%{
open System
open Microsoft.FSharp.Collections
open Lisp.Statements
%}
 
%token <int> NUMBER
%token <bool> BOOLEAN
%token END
 
%start start
%type <Lisp.Statements.Ast> start
 
%%
 
start:
    primitive END { $1 }
 
primitive:
    | NUMBER { Number($1) }
    | BOOLEAN { Boolean($1) }
 
%%

parser2.fsy

%{
open System
open Microsoft.FSharp.Collections
open Lisp.Statements
%}
 
%token <int> NUMBER
%token <bool> BOOLEAN
%token <string> IDENTIFIER
%token LPAREN RPAREN
%token END
 
%start start
%type <Lisp.Statements.Ast> start
 
%%
 
start:
    expression END { $1 }
 
expression:
    | NUMBER { Number($1) }
    | BOOLEAN { Boolean($1) }
    | LPAREN IDENTIFIER parameters { Call($2, $3) }
 
parameters:
    | RPAREN { [] }
    | expression parameters { $1 :: $2 }
%%

parser3.fsy

%{
open System
open Microsoft.FSharp.Collections
open Lisp.Statements
 
%}
 
%token <int> NUMBER
%token <bool> BOOLEAN
%token <string> IDENTIFIER
%token DEFUN
%token LPAREN RPAREN
%token END
 
%start start
%type <Lisp.Statements.Ast> start
 
%%
 
start:
    expression END { $1 }
 
expression:
    | NUMBER { Number($1) }
    | BOOLEAN { Boolean($1) }
    | IDENTIFIER { Identifier($1) }
    | LPAREN DEFUN IDENTIFIER LPAREN arguments expression RPAREN expression { Defun($3, $5, $6, $8) }
    | LPAREN IDENTIFIER parameters { Call($2, $3) }
 
parameters:
    | RPAREN { [] }
    | expression parameters { $1 :: $2 }
 
arguments:
    | RPAREN { [] }
    | IDENTIFIER arguments { $1 :: $2 }
 
%%

statements1.fs

namespace Lisp
module Statements =   
    type Ast =
    | Number of int
    | Boolean of bool

statements2.fs

namespace Lisp
module Statements =   
    type Ast =
    | Number of int
    | Boolean of bool
    | Call of string * Ast list

statements3.fs

namespace Lisp
module Statements =   
    type Ast =
    | Unparsed
    | Number of int
    | Boolean of bool
    | Call of string * Ast list
    | Identifier of string
    | Defun of string * Variable list * Ast * Ast
 
    and Variable = string