PollRobots

10 GOSUB 100
20 GOSUB 200
30 IF A <> 0 THEN GOTO 10
40 PRINT "Goodbye!"
50 END
100 '----------------------
101 ' read a number into A
102 '----------------------
110 PRINT "Enter a number";
120 INPUT A

PollRobots

module tinybasic

open System

type Expression =
| Number of int
| Variable of string
| String of string
| Binary of Expression * string * Expression
| Unary of string * Expression

PollRobots

    use compiler = new FSharpCodeProvider()
    let parameters = CompilerParameters()
    parameters.GenerateExecutable <- true
    parameters.GenerateInMemory <- true
    let result = compiler.CompileAssemblyFromSource(parameters, parser)
    if result.Errors.Count > 0 then
        for error in result.Errors do eprintfn "%O" error done
    else
        for output in result.Output do printfn "%O" output done
        printfn "Executing..."

PollRobots

let checkForLeftRecursion (rules:Map<string,Expression>) =
    let rec leftRules = function
    | Terminal _ | TerminalOneOf _ | TerminalUnicode _ | TerminalWildcard | Epsilon -> []
    | NonTerminal x -> [x]
    | ZeroOrMore x | OneOrMore x | Optional x | Not x | And x -> leftRules x
    | Choice x ->
        List.concat <| List.map leftRules x
    | Sequence x ->
        let rec processList = function
        | [] -> []

PollRobots

let codeGenRule b i first = function
| Rule _ as x ->
    ibprintf b i "%s " <| if first then "let rec" else "and"
    codeGen b i x
| x -> failwithf "Cannot generate code for %A" x

PollRobots

| Rule (x, y, z) ->
    ibprintfn b 0 "matchRule%s (input:string) (offset:int) = " <| capitalIdentifier x
    let j = i + 4 
    if z = "" then codeGen b j y else 
        ibprintfn b j "let res = "
        codeGen b (j + 4) y
        ibprintfn b 0 " in"
        ibprintfn b (j + 4) "match res with"
        ibprintfn b (j + 4) "| (Unmatched, _) -> (Unmatched, offset)"
        ibprintf b (j + 4) "| (parsed, endOffset) -> (%s input.[offset..endOffset - 1] parsed, endOffset)" z

PollRobots

| ZeroOrMore x | OneOrMore x | Optional x | And x | Not x as y ->
    let fn = match y with | ZeroOrMore _ -> "ZeroOrMore" | OneOrMore _ -> "OneOrMore" | Optional _ -> "Optional" | And _ -> "And" | Not _ -> "Not" | _ -> failwith "Internal Error"
    ibprintfn b i "match%s input offset (fun offset -> " fn
    codeGen b (i + 8) x
    ibprintf b 0 ");"

PollRobots

| Sequence x | Choice x as y ->
    let fn = match y with | Sequence _ -> "Sequence" | Choice _ -> "Choice" | _ -> failwith "Internal Error"
    let processItem index item =
        ibprintfn b 0 ""
        ibprintfn b (i + 4) "(fun offset -> "
        codeGen b (i + 8) item
        ibprintf b 0 ");"
    ibprintf b i "let l = ["
    List.iteri processItem x
    ibprintf b 0 "] in match%s input offset l" fn

PollRobots

let rec codeGen (b:StringBuilder) i = function
| Terminal x -> ibprintf b i """matchTerminal "%s" input offset""" <| escape x
| TerminalOneOf x -> ibprintf b i """matchTerminalOneOf "%s" input offset""" <| escape x
| TerminalWildcard -> ibprintf b i """matchTerminalWildcard input offset"""
| TerminalUnicode x -> ibprintf b i """matchTerminalUnicode System.Globalization.UnicodeCategory.%s input offset""" <| string(x)
| Epsilon -> ibprintf b i """if offset = input.Length then (EmptyMatch, offset) else (Unmatched, offset)"""
| NonTerminal x -> ibprintf b i """matchRule%s input offset""" <| capitalIdentifier x

PollRobots

    // unary <- ([!&] unary) / (atom [*+?])?
    let parseUnary _ = function
    | Production [TerminalSymbol "!"; Parsed x] -> Parsed <| Not x
    | Production [TerminalSymbol "&"; Parsed x] -> Parsed <| And x
    | Production [Parsed x; TerminalSymbol "*"] -> Parsed <| ZeroOrMore x
    | Production [Parsed x; TerminalSymbol "+"] -> Parsed <| OneOrMore x
    | Production [Parsed x; TerminalSymbol "?"] -> Parsed <| Optional x
    | Production [Parsed _ as x; EmptyMatch] -> x
    | x -> unexpected x
    let unaryRule = GrammarRule<Expression>(Choice [Sequence [TerminalOneOf "!&"; NonTerminal "unary"];