Scripting language in F#

Script.fs

module k


(*

type TypeIdent = string

type TypeExpr = name:string? (string | TypeIdent | Or TypeExpr TypeExpr | And TypeExpr)

type TypeDecl = Type string TypeExpr

type Bind = (Var | Let) string Expr

type Expr = Int

type Module = name:string (Expr | Bind | TypeDecl)*

*)

type ParseState =
    { Code : string; Index : int }
    member p.Rem = p.Code.Length - p.Index

type ParseResult<'a> = ('a * ParseState) option

type Parser<'a> = ParseState -> ParseResult<'a>

let ( ++ ) (a : Parser<'a>) (b : Parser<'b>) : Parser<'a * 'b> =
    fun p ->
        match a p with
        | Some (av, ap) ->
            match b ap with
            | Some (bv, bp) -> Some ((av, bv), bp)
            | None -> None
        | None -> None

let ( >>> ) (a : Parser<'a>) (m : 'a -> 'b) : Parser<'b> =
    fun p ->
        match a p with
        | Some (av, ap) -> Some (m av, ap)
        | None -> None

let opt (a : Parser<'a>) : Parser<'a option> =
    fun p ->
        match a p with
        | Some (av, ap) -> Some (Some av, ap)
        | None -> Some (None, p)

let either (ps : Parser<'a> list) : Parser<'a> =
    fun p ->
        ps |> List.tryPick (fun x -> x p)

let zeroOrMore (a : Parser<'a>) : Parser<'a list> =
    fun p ->
        let mutable cp = p
        let mutable cont = true
        let mutable r : 'a list = []
        while cont do
            match a cp with
            | Some (av, ap) -> r <- av :: r; cp <- ap
            | None -> cont <- false
        Some (List.rev r, cp)

let tok (s : string) : Parser<string> =
    let n = s.Length
    fun p ->
        if p.Rem < n then None
        else
            let mutable ok = true
            let mutable i = 0
            while ok && i < n do
                ok <- s.[i] = p.Code.[p.Index + i]
                i <- i + 1
            if ok then Some (s, { p with Index = p.Index + n })
            else None



type TypeIdent = string

type TypeExpr =
    | Named of TypeIdent
    | Or of TypeExpr list
    | And of TypeExpr list
    | Union of TypeExpr list

type TypeDecl =
    {
        Name : string
        Body : TypeExpr
    }

type Decl =
    | TypeDecl of TypeDecl

type ModuleChild =
//    | Expr of Expr
    | Decl of Decl

type Module =
    {
        Name : string option
        Children : ModuleChild list
    }



let (|Ident|_|) (p : ParseState) : ParseResult<string> =
    failwith "ni"

let (|NamedTypeExpr|_|) = (|Ident|_|) >>> fun i ->
    Named i

let (|TypeExpr|_|) = (|NamedTypeExpr|_|)    

let (|TypeDecl|_|) = (tok "type") ++ (|Ident|_|) ++ (tok "=") ++ (|TypeExpr|_|) >>> fun (((_, nm), _), b) ->
    { Name = nm; Body = b }

let (|Decl|_|) = (|TypeDecl|_|) >>> TypeDecl

let (|ModuleChild|_|) : Parser<ModuleChild> = (|Decl|_|) >>> Decl

let (|Module|_|) = opt (tok "module") ++ zeroOrMore (|ModuleChild|_|) >>> fun (mn, ch) ->
    { Name = mn; Children = ch }

let parse (code : string) : ParseState =
    { Code = code; Index = 0 }

let parseFile (path : string) : Module =
    let name = System.IO.Path.GetFileNameWithoutExtension (path)
    let code = System.IO.File.ReadAllText (path)
    match parse code with
    | Module (m, p1) -> m
    | _ -> { Name = Some name; Children = [] }