Skip to content

Instantly share code, notes, and snippets.

module tinybasic
open System
type Expression =
| Number of int
| Variable of string
| String of string
| Binary of Expression * string * Expression
| Unary of string * Expression
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
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
| [] -> []
| 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
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..."
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
| 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
// 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"];
| 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 ");"
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