5 people like it.
Like the snippet!
10 PRINT CHR$(205.5+RND(1)); : GOTO 10
Inspired by https://10print.org, this is a small incomplete BASIC interpreter that can generate a maze.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
|
type Token =
| Ident of string
| Operator of char
| Bracket of char
| Number of float
| String of string
let str rcl = System.String(Array.rev(Array.ofSeq rcl))
let isLetter c = (c >= 'A' && c <= 'Z') || c = '$'
let isOp c = "+".Contains(string c)
let isBracket c = "()".Contains(string c)
let isNumber c = (c >= '0' && c <= '9')
let rec tokenize toks = function
| c::cs when isLetter c -> ident toks [c] cs
| c::cs when isNumber c -> number toks [c] cs
| c::cs when isBracket c -> tokenize ((Bracket c)::toks) cs
| c::cs when isOp c -> tokenize ((Operator c)::toks) cs
| '"'::cs -> strend toks [] cs
| ' '::cs -> tokenize toks cs
| [] -> List.rev toks
| cs -> failwithf "Cannot tokenize: %s" (str (List.rev cs))
and strend toks acc = function
| '"'::cs -> tokenize (String(str acc)::toks) cs
| c::cs -> strend toks (c::acc) cs
| [] -> failwith "End of string not found"
and ident toks acc = function
| c::cs when isLetter c -> ident toks (c::acc) cs
| input -> tokenize (Ident(str acc)::toks) input
and number toks acc = function
| c::cs when isNumber c -> number toks (c::acc) cs
| '.'::cs when not (List.contains '.' acc) -> number toks ('.'::acc) cs
| input -> tokenize (Number(float (str acc))::toks) input
let tokenizeString s = tokenize [] (List.ofSeq s)
tokenizeString "10 PRINT \"{CLR/HOME}\""
tokenizeString "20 PRINT CHR$(205.5 + RND(1))"
tokenizeString "40 GOTO 20"
type Value =
| StringValue of string
| NumberValue of float
type Expression =
| Variable of string
| Const of Value
| Binary of char * Expression * Expression
| Function of string * Expression list
type Command =
| Print of Expression
| Goto of int
| List
| Run
let rec parseBinary left = function
| (Operator o)::toks ->
let right, toks = parseExpr toks
Binary(o, left, right), toks
| toks -> left, toks
and parseExpr = function
| (String s)::toks -> parseBinary (Const(StringValue s)) toks
| (Number n)::toks -> parseBinary (Const(NumberValue n)) toks
| (Ident i)::(Bracket '(')::toks ->
let rec loop args toks =
match toks with
| (Bracket ')')::toks -> List.rev args, toks
| _ ->
let arg, toks = parseExpr toks
loop (arg::args) toks
let args, toks = loop [] toks
parseBinary (Function(i, args)) toks
| (Ident v)::toks -> parseBinary (Variable v) toks
| toks -> failwithf "Parsing expr failed. Unexpected: %A" toks
let parseInput toks =
let line, toks =
match toks with
| (Number ln)::toks -> Some(int ln), toks
| _ -> None, toks
match toks with
| (Ident "LIST")::[] -> line, List
| (Ident "RUN")::[] -> line, Run
| (Ident "GOTO")::(Number lbl)::[] -> line, Goto(int lbl)
| (Ident "PRINT")::toks ->
let arg, toks = parseExpr toks
if toks <> [] then failwithf "Parsing print failed. Unexpected: %A" toks
line, Print(arg)
| _ -> failwithf "Parsing command failed. Unexpected: %A" toks
parseInput (tokenizeString "10 PRINT \"{CLR/HOME}\"")
parseInput (tokenizeString "20 PRINT CHR$(205.5 + RND(1))")
parseInput (tokenizeString "30 GOTO 20")
type Program =
list<int * Command>
let rec update (line, cmd) = function
| [] -> [line, cmd]
| (l, c)::p when line = l -> (l, cmd)::p
| (l, c)::p when line < l -> (line, cmd)::(l, c)::p
| (l, c)::p -> (l, c)::(update (line, cmd) p)
let rnd = System.Random()
let rec evaluate = function
| Const v -> v
| Binary('+', l, r) ->
match evaluate l, evaluate r with
| NumberValue l, NumberValue r -> NumberValue (l + r)
| _ -> failwith "Evaluating + failed"
| Function("RND", [arg]) ->
match evaluate arg with
| NumberValue arg -> NumberValue(float (rnd.Next(int arg + 1)))
| _ -> failwith "RND requires numeric argument"
| Function("CHR$", [arg]) ->
match evaluate arg with
| NumberValue arg when int arg = 205 -> StringValue("\\")
| NumberValue arg when int arg = 206 -> StringValue("//")
| _ -> failwith "CHR$ is hard"
let format = function
| StringValue s -> s
| NumberValue n -> string n
let rec run (ln, cmd) program =
match cmd with
| List ->
for n, l in program do
printfn "%d %A" n l
| Run ->
if not (List.isEmpty program) then
run (List.head program) program
| Goto lbl ->
match program |> List.tryFind (fun (l, _) -> l = lbl) with
| Some ln -> run ln program
| None -> failwithf "Line %d not found in program: %A" lbl program
| Print e ->
printf "%s" (format (evaluate e))
if ln <> -1 then
match program |> List.tryFind (fun (l, _) -> l > ln) with
| Some ln -> run ln program
| _ -> ()
let input cmd program =
match parseInput (tokenizeString cmd) with
| Some(ln), cmd -> update (ln, cmd) program
| None, cmd -> run (-1, cmd) program; program
[]
|> input "10 PRINT \"{CLR/HOME}\""
|> input "20 PRINT CHR$(205.5 + RND(1))"
|> input "30 GOTO 20"
|> input "RUN"
|
union case Token.Ident: string -> Token
Multiple items
val string : value:'T -> string
--------------------
type string = System.String
union case Token.Operator: char -> Token
Multiple items
val char : value:'T -> char (requires member op_Explicit)
--------------------
type char = System.Char
union case Token.Bracket: char -> Token
union case Token.Number: float -> Token
Multiple items
val float : value:'T -> float (requires member op_Explicit)
--------------------
type float = System.Double
--------------------
type float<'Measure> = float
Multiple items
union case Token.String: string -> Token
--------------------
module String
from Microsoft.FSharp.Core
val str : rcl:seq<char> -> System.String
val rcl : seq<char>
namespace System
Multiple items
type String =
new : value:char[] -> string + 8 overloads
member Chars : int -> char
member Clone : unit -> obj
member CompareTo : value:obj -> int + 1 overload
member Contains : value:string -> bool + 3 overloads
member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
member EndsWith : value:string -> bool + 3 overloads
member EnumerateRunes : unit -> StringRuneEnumerator
member Equals : obj:obj -> bool + 2 overloads
member GetEnumerator : unit -> CharEnumerator
...
--------------------
System.String(value: char []) : System.String
System.String(value: nativeptr<char>) : System.String
System.String(value: nativeptr<sbyte>) : System.String
System.String(value: System.ReadOnlySpan<char>) : System.String
System.String(c: char, count: int) : System.String
System.String(value: char [], startIndex: int, length: int) : System.String
System.String(value: nativeptr<char>, startIndex: int, length: int) : System.String
System.String(value: nativeptr<sbyte>, startIndex: int, length: int) : System.String
System.String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: System.Text.Encoding) : System.String
module Array
from Microsoft.FSharp.Collections
val rev : array:'T [] -> 'T []
val ofSeq : source:seq<'T> -> 'T []
val isLetter : c:char -> bool
val c : char
val isOp : c:char -> bool
val isBracket : c:char -> bool
val isNumber : c:char -> bool
val tokenize : toks:Token list -> _arg1:char list -> Token list
val toks : Token list
val cs : char list
val ident : toks:Token list -> acc:char list -> _arg3:char list -> Token list
val number : toks:Token list -> acc:char list -> _arg4:char list -> Token list
val strend : toks:Token list -> acc:char list -> _arg2:char list -> Token list
Multiple items
module List
from Microsoft.FSharp.Collections
--------------------
type List<'T> =
| ( [] )
| ( :: ) of Head: 'T * Tail: 'T list
interface IReadOnlyList<'T>
interface IReadOnlyCollection<'T>
interface IEnumerable
interface IEnumerable<'T>
member GetReverseIndex : rank:int * offset:int -> int
member GetSlice : startIndex:int option * endIndex:int option -> 'T list
member Head : 'T
member IsEmpty : bool
member Item : index:int -> 'T with get
member Length : int
...
val rev : list:'T list -> 'T list
val failwithf : format:Printf.StringFormat<'T,'Result> -> 'T
val acc : char list
val failwith : message:string -> 'T
val input : char list
val not : value:bool -> bool
val contains : value:'T -> source:'T list -> bool (requires equality)
val tokenizeString : s:seq<char> -> Token list
val s : seq<char>
val ofSeq : source:seq<'T> -> 'T list
type Value =
| StringValue of string
| NumberValue of float
union case Value.StringValue: string -> Value
union case Value.NumberValue: float -> Value
type Expression =
| Variable of string
| Const of Value
| Binary of char * Expression * Expression
| Function of string * Expression list
union case Expression.Variable: string -> Expression
union case Expression.Const: Value -> Expression
union case Expression.Binary: char * Expression * Expression -> Expression
union case Expression.Function: string * Expression list -> Expression
type 'T list = List<'T>
type Command =
| Print of Expression
| Goto of int
| List
| Run
union case Command.Print: Expression -> Command
union case Command.Goto: int -> Command
Multiple items
val int : value:'T -> int (requires member op_Explicit)
--------------------
type int = int32
--------------------
type int<'Measure> = int
Multiple items
union case Command.List: Command
--------------------
module List
from Microsoft.FSharp.Collections
--------------------
type List<'T> =
| ( [] )
| ( :: ) of Head: 'T * Tail: 'T list
interface IReadOnlyList<'T>
interface IReadOnlyCollection<'T>
interface IEnumerable
interface IEnumerable<'T>
member GetReverseIndex : rank:int * offset:int -> int
member GetSlice : startIndex:int option * endIndex:int option -> 'T list
member Head : 'T
member IsEmpty : bool
member Item : index:int -> 'T with get
member Length : int
...
union case Command.Run: Command
val parseBinary : left:Expression -> _arg1:Token list -> Expression * Token list
val left : Expression
val o : char
val right : Expression
val parseExpr : _arg2:Token list -> Expression * Token list
val s : string
val n : float
val i : string
val loop : (Expression list -> Token list -> Expression list * Token list)
val args : Expression list
val arg : Expression
val v : string
val parseInput : toks:Token list -> int option * Command
val line : int option
val ln : float
union case Option.Some: Value: 'T -> Option<'T>
union case Option.None: Option<'T>
val lbl : float
type Program = (int * Command) list
val update : line:'a * cmd:'b -> _arg1:('a * 'b) list -> ('a * 'b) list (requires comparison)
val line : 'a (requires comparison)
val cmd : 'b
val l : 'a (requires comparison)
val c : 'b
val p : ('a * 'b) list (requires comparison)
val rnd : System.Random
Multiple items
type Random =
new : unit -> Random + 1 overload
member Next : unit -> int + 2 overloads
member NextBytes : buffer:byte[] -> unit + 1 overload
member NextDouble : unit -> float
--------------------
System.Random() : System.Random
System.Random(Seed: int) : System.Random
val evaluate : _arg1:Expression -> Value
val v : Value
val l : Expression
val r : Expression
val l : float
val r : float
val arg : float
System.Random.Next() : int
System.Random.Next(maxValue: int) : int
System.Random.Next(minValue: int, maxValue: int) : int
val format : _arg1:Value -> string
val run : ln:int * cmd:Command -> program:(int * Command) list -> unit
val ln : int
val cmd : Command
val program : (int * Command) list
val n : int
val l : Command
val printfn : format:Printf.TextWriterFormat<'T> -> 'T
val isEmpty : list:'T list -> bool
val head : list:'T list -> 'T
val lbl : int
val tryFind : predicate:('T -> bool) -> list:'T list -> 'T option
val l : int
val ln : int * Command
val e : Expression
val printf : format:Printf.TextWriterFormat<'T> -> 'T
val input : cmd:seq<char> -> program:(int * Command) list -> (int * Command) list
val cmd : seq<char>
More information