Skim.fs

module Skim.Main

open System
open System.IO
open System.Linq

type Sexp =
    | Atom of Value
    | List of Sexp list
and Value =
    | None
    | Function of (Sexp list -> Map<string, Value> -> Value)
    | Number of int
    | Ident of string
    | Quote of Sexp
    
let rec ExecuteOne sexp (bindings : Map<string,Value>) : Value =
    match sexp with
    | Atom s ->
        match s with
        | Ident s ->
            bindings.[s]
        | _ -> s
    | List l ->
        match l with
        | [] -> None
        | x :: xs ->
            let v = ExecuteOne x bindings
            match v with
            | Function f -> f xs bindings
            | any -> raise <| Exception "bad program"

let Execute sexps bindings =
    List.fold (fun _ v -> ExecuteOne v bindings) None sexps

let Let (xs : Sexp list) bindings =
    if xs.Length < 2 then
        raise <| Exception "bad program"
    else
        let bind, exec = xs.Head, xs.Tail
        match bind with
        | List l ->
            if l.Length < 2 then
                raise <| Exception "bad program"
            else
                match l.Head with
                | Atom (Ident s) ->
                    Execute exec (Map.add s (Execute l.Tail bindings) bindings)
                | _ -> raise <| Exception "bad program"
        | _ -> raise <| Exception "bad program"

let Dot (xs : Sexp list) bindings =
    if xs.Length <> 3 then
        raise <| Exception "bad program"
    else
        match ExecuteOne xs.[0] bindings with
        | Number 0 | None ->
            match ExecuteOne xs.[2] bindings with
            | Quote todo -> ExecuteOne todo bindings
            | _ -> raise <| Exception "bad program"
        | _ ->
            match ExecuteOne xs.[1] bindings with
            | Quote todo -> ExecuteOne todo bindings
            | _ -> raise <| Exception "bad program"

let Apply op (xs : Sexp list) bindings =
    let rec app l accum =
        match l with
        | [] -> accum
        | x :: xs ->
            match ExecuteOne x bindings with
            | Number n -> app xs (op accum n)
            | _ -> raise <| Exception "bad program"
    if xs.Length < 2 then
        raise <| Exception "bad program"
    else
        match ExecuteOne xs.Head bindings with
        | Number n -> Number <| app xs.Tail n
        | _ -> raise <| Exception "bad program"

let In (xs : Sexp list) bindings =
    if xs.Length <> 0 then
        raise <| Exception "bad program"
    else
        Number (Console.Read ())

let rec Out (xs : Sexp list) bindings =
    match xs with
    | [] -> None
    | x :: xs ->
        match ExecuteOne x bindings with
        | Number n ->
            Console.Write((char n))
            Out xs bindings
        | _ -> raise <| Exception "bad program"

let bindings =
    (Map.add "i" (Function In)
        (Map.add "o" (Function Out)
            (Map.add "-" (Function (Apply (-)))
                (Map.add "+" (Function (Apply (+)))
                    (Map.add "let" (Function Let)
                        (Map.add "." (Function Dot)
                            (Map.add "1" (Number 1)
                                Map.empty)))))))

let rec ParseOne (data : char list) : Sexp * char list =
    let rec parseList l accum =
        match l with
        | [] -> raise <| Exception "bad program"
        | ')' :: xs -> List accum, xs
        | _ ->
            let n, r = ParseOne l
            parseList r (accum @ [n])
    let rec parseIdent l accum =
        match l with
        | [] -> raise <| Exception "bad program"
        | x :: xs ->
            match x with
            | ' ' | ')' | '\n' | '\r' | '\t' -> accum, l
            | v -> parseIdent xs (accum @ [v])
    match data with
    | [] -> Atom None, []
    | x :: xs ->
        match x with
        | ' ' | '\n' | '\r' | '\t' -> ParseOne xs
        | '(' -> parseList xs []
        | '\'' ->
            let n, r = ParseOne xs
            Atom (Quote n), r
        | c ->
            let n, r = parseIdent data []
            Atom (Ident (String.Concat (Array.ofList n))), r   

let rec Parse (data : char list) accum : Sexp list =
    match data with
    | [] -> accum
    | _ ->
        let v, d = ParseOne data
        Parse d (accum @ [v])

[<EntryPoint>]
let main args = 
    if args.Length <> 1 then
        Console.WriteLine ("usage: skim.exe filename")
        1
    else
        use f = File.OpenRead args.[0]
        let tmp = new System.Collections.Generic.List<byte> ()
        let buff = Array.zeroCreate 1024
        let n = ref -1
        while !n <> 0 do
            n := f.Read (buff, 0, 1024)
            if !n <> 0 then
                tmp.AddRange (buff.Take !n) |> ignore
        let data = List.ofArray <| System.Text.UTF8Encoding.UTF8.GetChars (tmp.ToArray ())
        Execute (Parse data []) bindings |> ignore
        0