Small Small Basic Parser FParsec sample

SmallSmallBasicParser.fsx

// Type abbreviations
type label = string
type identifier = string
type index = int
type HashTable<'k,'v> = System.Collections.Generic.Dictionary<'k,'v>
/// Small Basic arithmetic operation
type arithmetic = Add | Subtract | Multiply | Divide
/// Small Basic comparison operaton
type comparison = Eq | Ne | Lt | Gt | Le | Ge
/// Small Basic logical operation
type logical = And | Or
/// Small Basic value
type value =
    | Bool of bool
    | Int of int
    | Double of double
    | String of string
    | Array of HashTable<value,value>
/// Small Basic expression
type expr =
    | Literal of value
    | Var of identifier
    | GetAt of location
    | Func of invoke
    | Neg of expr
    | Arithmetic of expr * arithmetic * expr
    | Comparison of expr * comparison * expr
    | Logical of expr * logical * expr
and location =
    | Location of identifier * expr list
and invoke =
    | Method of string * string * expr[]
    | PropertyGet of string * string
/// Small Basic assignment
type assign =
    | Set of identifier * expr
/// Small Basic instruction
type instruction =
    | Assign of assign
    | SetAt of location * expr
    | PropertySet of string * string * expr
    | Action of invoke
    | For of assign * expr * expr
    | EndFor
    | If of expr
    | ElseIf of expr
    | Else
    | EndIf
    | While of expr
    | EndWhile
    | Sub of identifier
    | EndSub
    | GoSub of identifier
    | Label of label
    | Goto of label

#r @"..\packages\FParsec.1.0.1\lib\net40-client\FParsecCS.dll"
#r @"..\packages\FParsec.1.0.1\lib\net40-client\FParsec.dll"


open FParsec

let ptrue = stringReturn "true" true
let pfalse = stringReturn "false" false
let pbool = (ptrue <|> pfalse) |>> fun x -> Bool(x)
let pint = pint32 |>> fun n -> Int(n)
let pvalue = pbool <|> pint

let pliteral = pvalue |>> fun x -> Literal(x)

let pidentifier =
    let isIdentifierFirstChar c = isLetter c || c = '_'
    let isIdentifierChar c = isLetter c || isDigit c || c = '_'
    many1Satisfy2L isIdentifierFirstChar isIdentifierChar "identifier"

let pvar = pidentifier |>> fun name -> Var(name)
let pexpr = pliteral <|> pvar

let pset = pipe3 pidentifier (pstring "=") pexpr (fun id _ e -> Set(id, e))

let pfor =
    let pfrom = pstring "For" >>. spaces1 >>. pset .>> spaces1
    let pto = pstring "To" >>. spaces1 >>. pexpr
    let pstep = pstring "Step" >>. spaces1 >>. pexpr
    let toStep = function None -> Literal(Int(1)) | Some s -> s
    pipe3 pfrom pto (opt pstep) (fun f t s -> For(f, t, toStep s))

let pstatement = 
    choice [
        attempt pfor
        // ... other statements
    ]
 
run pfor "For A=1 To 100"

let pcomment = 
    pchar '\'' >>. skipManySatisfy (fun c -> c <> '\n') >>. pchar '\n'

let peol = pcomment <|> (pchar '\n')
let plines = many (spaces >>. pstatement .>> peol) .>> eof
let parse (program:string) =    
    match run plines program with
    | Success(result, _, _)   -> result
    | Failure(errorMsg, e, s) -> failwith errorMsg

let program = 
    parse """For A=1 To 100
"""