lamda-calc-fsharp-option-pure.fsx

lamda-calc-fsharp-option-pure.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) option =
  match tokens with
    | (Variable name::rest) -> Some (VariableT name, rest)
    | (Lambda::Variable arg::Dot::bodyCode) ->
      let perhapsValue = parseSingle bodyCode

      Option.map (fun (body, rest) -> LambdaT (arg, body), rest) perhapsValue

    | LParen::code ->
      let perhapsFirst = parseSingle code
      let perhapsSecond = Option.bind (fun (_, afterFirst) -> parseSingle afterFirst) perhapsFirst

      match perhapsFirst, perhapsSecond with
        | Some (fn, _), Some (value, RParen::rest) -> Some (ApplicationT (fn, value), rest)
        | _ ->
          None
    | _ ->
      None


let parse (tokens: Token list): Term option = 
  Option.map fst <| parseSingle tokens

let rec evalInEnv (env: Env) (term: Term): Term option =
  match term with
    | VariableT name ->
      env
        |> List.tryFind (fun (aName, term) -> aName = name)
        |> Option.map snd
    | LambdaT (arg, body) ->
      Some (ClosureT (arg, body, env))
    | ApplicationT (fn, value) ->
      match evalInEnv env fn with
        | Some (ClosureT (arg, body, closedEnv)) ->
          match evalInEnv env value with
            | Some evaluatedValue  ->
              let newEnv = (arg, evaluatedValue)::closedEnv @ env

              evalInEnv newEnv body
            | _ -> None
        | _ ->
          None
    | closure -> Some closure

let eval (term: Term): Term option =
  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) option =
  tokenize
    >> parse
    >> Option.bind eval
    >> Option.map pretty

let interpString: string -> string option =
  List.ofSeq
    >> interp
    >> Option.map (List.map string)
    >> Option.map (String.concat "")