Skip to content

Instantly share code, notes, and snippets.

@mjgpy3
Created September 15, 2017 05:48
Show Gist options
  • Save mjgpy3/547db15b0a0b67e8ad3f49421e07b25d to your computer and use it in GitHub Desktop.
Save mjgpy3/547db15b0a0b67e8ad3f49421e07b25d to your computer and use it in GitHub Desktop.
lets-write-a-lambda-calc-in-fsharp.fsx
(*
Examples:
\x.x -----> \x.x
x -----> error!!!
(\x.x \y.y) -----> \y.y
((\x.\y.x \a.(a a)) \b.b) -----> \a.(a a)
*)
type Token =
| LParen
| RParen
| Lambda
| Dot
| Variable of char
let alphabet = List.ofSeq "abcdefghijklmnopqrstuvwxyz"
let rec tokenize (text: char list) =
match text with
| [] -> []
| '('::rest -> LParen::tokenize rest
| ')'::rest -> RParen::tokenize rest
| '.'::rest -> Dot::tokenize rest
| '\\'::rest -> Lambda::tokenize rest
| c::rest ->
(if List.contains c alphabet
then [Variable c]
else []) @ tokenize rest
type Term =
| VariableT of char
| LambdaT of char*Term
| ClosureT of char*Term*Env
| ApplicationT of Term*Term
and Env = (char*Term) list
let rec parseSingle (tokens: Token list): (Term*Token list) =
match tokens with
| (Variable name::rest) -> VariableT name, rest
| (Lambda::Variable arg::Dot::bodyCode) ->
let body, rest = parseSingle bodyCode
LambdaT (arg, body), rest
| LParen::code ->
let fn, afterFirst = parseSingle code
let value, afterValue = parseSingle afterFirst
match afterValue with
| RParen::rest -> ApplicationT (fn, value), rest
| _ ->
failwith "Expected )"
| _ ->
failwith "Bad parse"
let parse (tokens: Token list) =
fst <| parseSingle tokens
let rec evalInEnv (env: Env) (term: Term): Term =
match term with
| VariableT name ->
match List.tryFind (fun (aName, term) -> aName = name) env with
| Some (_, term) -> term
| None -> failwith "Couldn't find a term by name"
| LambdaT (arg, body) ->
ClosureT (arg, body, env)
| ApplicationT (fn, value) ->
match evalInEnv env fn with
| ClosureT (arg, body, closedEnv) ->
let evaluatedValue = evalInEnv env value
let newEnv = (arg, evaluatedValue)::closedEnv @ env
evalInEnv newEnv body
| _ ->
failwith "Cannot apply something given"
| closure -> closure
let eval (term: Term): Term =
evalInEnv [] term
let rec pretty (term: Term): char list =
match term with
| VariableT name -> [name]
| LambdaT (arg, body) -> ['\\'; arg; '.'] @ pretty body
| ClosureT (arg, body, _) -> ['\\'; arg; '.'] @ pretty body
| ApplicationT (fn, value) -> ['('] @ pretty fn @ [' '] @ pretty value @ [')']
let interp: char list -> char list =
tokenize
>> parse
>> eval
>> pretty
let interpString: string -> string =
List.ofSeq
>> interp
>> List.map string
>> String.concat ""
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment