5 people like it.

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>
Raw view Test code New version

More information

Link:http://fssnip.net/7Z6
Posted:4 years ago
Author:Tomas Petricek
Tags: basic , interpreter , parsing