BASIC interpreter

• PRINT expression
  
  

  Prints the result of the evaluation of the expression.

  
  
• INPUT variable
  
  

  Prints a prompt (?), reads an integer typed in by the user, and assigns its value to the variable.

  
  
• LET variable = expression
  
  

  Assigns the result of the evaluation of expression to the variable.

  
  
• GOTO line number
  
  

  Continues execution at the given line.

  
  
• IF condition THEN line number
  
  

  Continues execution at the given line if the condition is true.

  
  
• REM any string
  
  

  One-line comment.

 
 5  REM inputting the argument
10  PRINT " factorial of:"
20  INPUT A
30  LET B = 1 
35  REM beginning of the loop
40  IF A <= 1 THEN 80 
50  LET B = B * A
60  LET A = A - 1
70  GOTO 40 
75  REM prints the result
80  PRINT B

> RUN
 factorial of: ? 5
120

Description of the abstract syntax

: describes the definition of data types to represent Basic programs, as well as their components (lines, commands, expressions, etc.).

Program pretty printing

: consists of transforming the internal representation of Basic programs to strings, in order to display them.

Lexing and parsing

: accomplish the inverse transformation, that is, transform a string into the internal representation of a Basic program (the abstract syntax).

Evaluation

: is the heart of the interpreter. It controls and runs the program. As we will see, functional languages, such as Objective CAML, are particularly well adapted for this kind of problem.

Toplevel interactive loop

: glues together all the previous parts.

Abstract syntax

---

Unary_Op	::=	-    |    !
Binary_Op	::=	+    |    -    |    *    |    /    |    %
	|	=    |    <    |    >    |    <=    |    >=    |    <>
	|	&    |    ' | '
Expression	::=	integer
	|	variable
	|	"string"
	|	Unary_Op   Expression
	|	Expression   Binary_Op   Expression
	|	( Expression )
Command	::=	REM string
	|	GOTO integer
	|	LET variable = Expression
	|	PRINT Expression
	|	INPUT variable
	|	IF Expression THEN integer
Line	::=	integer Command
Program	::=	Line
	|	Line Program
Phrase	::=	Line | RUN | LIST | END

Figure 6.2: BASIC Grammar.

---

# type unr_op = UMINUS | NOT  ;;
# type bin_op = PLUS | MINUS | MULT | DIV | MOD  
             | EQUAL | LESS | LESSEQ | GREAT | GREATEQ | DIFF 
             | AND | OR  ;;
# type expression = 
     ExpInt of int 
   | ExpVar of string
   | ExpStr of string 
   | ExpUnr of unr_op * expression
   | ExpBin of expression * bin_op * expression  ;;
# type command = 
     Rem of string
   | Goto of int 
   | Print of expression
   | Input of string 
   | If of expression * int 
   | Let of string * expression  ;;
# type line = { num : int ; cmd : command }  ;;
# type program = line list  ;;

# type phrase =  Line of line | List | Run | PEnd  ;;

# let priority_uop = function NOT -> 1 | UMINUS -> 7
 let priority_binop = function 
     MULT | DIV  -> 6
   | PLUS | MINUS -> 5
   | MOD -> 4
   | EQUAL | LESS | LESSEQ | GREAT | GREATEQ | DIFF -> 3
   | AND | OR -> 2 ;;
val priority_uop : unr_op -> int = <fun>
val priority_binop : bin_op -> int = <fun>

Program pretty printing

# let pp_binop = function  
     PLUS -> "+" | MULT -> "*" | MOD   -> "%" | MINUS -> "-" 
   | DIV -> "/"  | EQUAL -> " = " | LESS -> " < " 
   | LESSEQ -> " <= "   | GREAT   -> " > " 
   | GREATEQ -> " >= "   | DIFF  -> " <> " | AND -> " & " | OR -> " | "  
 let pp_unrop = function UMINUS -> "-"  | NOT -> "!"  ;;
val pp_binop : bin_op -> string = <fun>
val pp_unrop : unr_op -> string = <fun>

# let parenthesis x = "(" ^ x ^ ")";;  
val parenthesis : string -> string = <fun>
# let pp_expression = 
  let rec ppl pr = function 
       ExpInt n -> (string_of_int n)
     | ExpVar v -> v 
     | ExpStr s -> "\"" ^ s ^ "\"" 
     | ExpUnr (op,e) -> 
         let res = (pp_unrop op)^(ppl (priority_uop op) e) 
         in if pr=0 then res else parenthesis res 
     | ExpBin (e1,op,e2) -> 
         let pr2 = priority_binop op
         in let res = (ppl pr2 e1)^(pp_binop op)^(ppr pr2 e2)
         (* parenthesis if priority is not greater *)
         in if pr2 >= pr then res else parenthesis res
   and ppr pr exp = match exp with 
     (*  right subtrees only differ for binary operators *)
       ExpBin (e1,op,e2) -> 
         let pr2 = priority_binop op
         in let res = (ppl pr2 e1)^(pp_binop op)^(ppr pr2 e2)
         in if pr2 > pr then res else parenthesis res
     | _ -> ppl pr exp
   in ppl 0 ;;
val pp_expression : expression -> string = <fun>

# let pp_command = function 
     Rem s     ->  "REM " ^ s
   | Goto n    ->  "GOTO " ^ (string_of_int n)
   | Print e   ->  "PRINT " ^ (pp_expression e)
   | Input v   ->  "INPUT " ^ v
   | If (e,n)  ->  "IF "^(pp_expression e)^" THEN "^(string_of_int n)
   | Let (v,e) ->  "LET " ^ v ^ " = " ^ (pp_expression e)  ;;
val pp_command : command -> string = <fun>
# let pp_line l = (string_of_int l.num) ^ "  " ^ (pp_command l.cmd)  ;;
val pp_line : line -> string = <fun>

Lexing

# type lexeme = Lint of int 
             | Lident of string 
             | Lsymbol of string  
             | Lstring of string
             | Lend ;;

# type string_lexer = {string:string; mutable current:int; size:int } ;;

# let init_lex s = { string=s; current=0 ; size=String.length s } ;;
val init_lex : string -> string_lexer = <fun>
# let forward cl = cl.current <- cl.current+1  ;;
val forward : string_lexer -> unit = <fun>
# let forward_n cl n = cl.current <- cl.current+n ;;
val forward_n : string_lexer -> int -> unit = <fun>
# let extract pred cl = 
   let st = cl.string and pos = cl.current in
   let rec ext n = if n<cl.size && (pred st.[n]) then ext (n+1) else n in 
   let res = ext pos
   in cl.current <- res ; String.sub cl.string pos (res-pos)  ;;
val extract : (char -> bool) -> string_lexer -> string = <fun>

# let extract_int = 
    let is_int = function '0'..'9' -> true | _ -> false  
    in function cl -> int_of_string (extract is_int cl)
 let extract_ident =
    let is_alpha_num = function 
      'a'..'z' | 'A'..'Z' | '0' .. '9' | '_' -> true 
    | _ -> false  
    in extract is_alpha_num ;;
val extract_int : string_lexer -> int = <fun>
val extract_ident : string_lexer -> string = <fun>

# exception LexerError ;;
exception LexerError
# let  rec lexer cl = 
   let lexer_char c = match c with 
       ' ' 
     | '\t'     -> forward cl ; lexer cl 
     | 'a'..'z' 
     | 'A'..'Z' -> Lident (extract_ident cl)
     | '0'..'9' -> Lint (extract_int cl)
     | '"'      -> forward cl ; 
                   let res = Lstring (extract ((<>) '"') cl) 
                   in forward cl ; res 
     | '+' | '-' | '*' | '/' | '%' | '&' | '|' | '!' | '=' | '(' | ')'  -> 
                   forward cl; Lsymbol (String.make 1 c)
     | '<' 
     | '>'      -> forward cl; 
                   if cl.current >= cl.size then Lsymbol (String.make 1 c)
                   else  let cs = cl.string.[cl.current] 
                         in ( match (c,cs) with 
                                ('<','=') -> forward cl; Lsymbol "<=" 
                              | ('>','=') -> forward cl; Lsymbol ">="
                              | ('<','>') -> forward cl; Lsymbol "<>"
                              |     _     -> Lsymbol (String.make 1 c) )
     | _ -> raise LexerError
   in 
      if cl.current >= cl.size then Lend 
      else lexer_char cl.string.[cl.current] ;;
val lexer : string_lexer -> lexeme = <fun>

Parsing

---

Figure 6.3: Basic: abstract syntax tree examples.

---

# type exp_elem = 
     Texp of expression   (* expression       *)
   | Tbin of bin_op       (* binary operator  *)
   | Tunr of unr_op       (* unary operator   *)
   | Tlp                  (* left parenthesis *) ;;

---

Figure 6.4: Basic: abstract syntax tree construction example.

---

# exception ParseError ;;

# let unr_symb = function 
   "!" -> NOT | "-" -> UMINUS | _ -> raise ParseError 
 let bin_symb = function
     "+" -> PLUS | "-" -> MINUS | "*" -> MULT | "/" -> DIV | "%" -> MOD 
   | "=" -> EQUAL | "<" -> LESS | "<=" -> LESSEQ | ">" -> GREAT 
   | ">=" -> GREATEQ | "<>" -> DIFF | "&" -> AND | "|" -> OR 
   | _ -> raise ParseError 
 let tsymb s = try Tbin (bin_symb s) with ParseError -> Tunr (unr_symb s) ;;
val unr_symb : string -> unr_op = <fun>
val bin_symb : string -> bin_op = <fun>
val tsymb : string -> exp_elem = <fun>

• an expression followed by a unary operator,
• an expression followed by a binary operator and an expression.

# let reduce pr = function 
     (Texp e)::(Tunr op)::st  when  (priority_uop op) >= pr
        -> (Texp (ExpUnr (op,e)))::st
   | (Texp e1)::(Tbin op)::(Texp e2)::st  when  (priority_binop op) >= pr
        -> (Texp (ExpBin (e2,op,e1)))::st 
   | _ -> raise ParseError ;;
val reduce : int -> exp_elem list -> exp_elem list = <fun>

# let rec stack_or_reduce lex stack = match lex , stack with 
     Lint n ,  _      ->  (Texp (ExpInt n))::stack 
   | Lident v ,  _    ->  (Texp (ExpVar v))::stack 
   | Lstring s , _    ->  (Texp (ExpStr s))::stack
   | Lsymbol "(" , _  ->  Tlp::stack
   | Lsymbol ")" , (Texp e)::Tlp::st  ->  (Texp e)::st
   | Lsymbol ")" , _ -> stack_or_reduce lex (reduce 0 stack) 
   | Lsymbol s , _ 
        -> let symbol = 
             if s<>"-" then tsymb s 
             (* remove the ambiguity of the ``-'' symbol           *)
             (* according to the last exp element put on the stack *)
             else match stack 
                  with (Texp _)::_  ->  Tbin MINUS 
                                | _ ->  Tunr UMINUS 
           in ( match symbol with 
                  Tunr op  ->  (Tunr op)::stack 
                | Tbin op  -> 
                    ( try stack_or_reduce lex (reduce (priority_binop op) 
                                               stack )
                      with ParseError -> (Tbin op)::stack )
                | _ -> raise ParseError )
   | _ , _ -> raise ParseError ;;
val stack_or_reduce : lexeme -> exp_elem list -> exp_elem list = <fun>

# let rec reduce_all = function 
   | [] -> raise ParseError
   | [Texp x] -> x 
   | st -> reduce_all (reduce 0 st) ;;
val reduce_all : exp_elem list -> expression = <fun>

# let parse_exp stop cl = 
   let p = ref 0 in 
   let rec parse_one stack  = 
     let l = ( p:=cl.current ; lexer cl)
     in if not (stop l) then parse_one (stack_or_reduce l stack)
        else ( cl.current <- !p ; reduce_all stack )
   in parse_one []  ;;
val parse_exp : (lexeme -> bool) -> string_lexer -> expression = <fun>

# let parse_cmd cl = match lexer cl with 
     Lident s -> ( match s with 
         "REM" -> Rem (extract (fun _ -> true) cl)
       | "GOTO" -> Goto (match lexer cl with 
                           Lint p -> p 
                         | _ -> raise ParseError)
       | "INPUT" -> Input (match lexer cl with 
                             Lident v -> v 
                           | _ -> raise ParseError)
       | "PRINT" -> Print (parse_exp ((=) Lend) cl)
       | "LET" -> 
           let l2 = lexer cl and l3 = lexer cl 
           in ( match l2 ,l3 with 
                    (Lident v,Lsymbol "=") -> Let (v,parse_exp ((=) Lend) cl)
                  | _ -> raise ParseError )
       | "IF" -> 
           let test = parse_exp ((=) (Lident "THEN")) cl 
           in ( match ignore (lexer cl) ; lexer cl with 
                   Lint n  ->  If (test,n) 
                 | _ -> raise ParseError )
       | _ -> raise ParseError ) 
   | _ -> raise ParseError  ;;
val parse_cmd : string_lexer -> command = <fun>

# let parse str = 
   let cl = init_lex str 
   in match lexer cl with 
       Lint n -> Line { num=n ; cmd=parse_cmd cl }
     | Lident "LIST" -> List 
     | Lident "RUN" -> Run 
     | Lident "END" -> PEnd 
     | _ -> raise ParseError  ;;
val parse : string -> phrase = <fun>

Evaluation

# type value = Vint of int | Vstr of string | Vbool of bool  ;;

 
# type environment = (string * value) list ;;

# type code = line array ;;

# type state_exec = { line:int ; xprog:code ; xenv:environment } ;;

# exception RunError of int 
 let runerr n = raise (RunError n) ;;
exception RunError of int
val runerr : int -> 'a = <fun>

Assembly

# exception Result_lookup_index of int ;;
exception Result_lookup_index of int
# let lookup_index tprog num_line =
   try 
     for i=0 to (Array.length tprog)-1 do 
       let num_i = tprog.(i).num
       in if num_i=num_line then raise (Result_lookup_index i)
          else if num_i>num_line then raise (Result_lookup_index (-1))
     done ;
     (-1 )
   with Result_lookup_index i -> i ;;
val lookup_index : line array -> int -> int = <fun>

# let assemble prog =
   let tprog = Array.of_list prog in
     for i=0 to (Array.length tprog)-1 do
       match tprog.(i).cmd with
           Goto n -> let index = lookup_index tprog n
                     in tprog.(i) <- { tprog.(i) with cmd = Goto index }
         | If(c,n) -> let index = lookup_index tprog n
                      in tprog.(i) <- { tprog.(i) with cmd = If (c,index) }
         | _ -> ()
     done ;
   tprog ;;
val assemble : line list -> line array = <fun>

Expression evaluation

# let rec eval_exp n envt expr = match expr with 
     ExpInt p  ->  Vint p
   | ExpVar v  -> ( try List.assoc v envt with Not_found -> runerr n )
   | ExpUnr (UMINUS,e) ->  
       ( match eval_exp n envt e with 
           Vint p -> Vint (-p) 
         | _ -> runerr n )
   | ExpUnr (NOT,e) ->  
       ( match eval_exp n envt e with 
           Vbool p -> Vbool (not p) 
         | _ -> runerr n )
   | ExpStr s -> Vstr s  
   | ExpBin (e1,op,e2) 
       -> match eval_exp n envt e1 , op , eval_exp n envt e2 with
               Vint v1 , PLUS   , Vint v2  ->  Vint (v1 + v2) 
             | Vint v1 , MINUS  , Vint v2  ->  Vint (v1 - v2) 
             | Vint v1 , MULT   , Vint v2  ->  Vint (v1 * v2) 
             | Vint v1 ,  DIV   , Vint v2  when v2<>0 ->  Vint (v1 / v2) 
             | Vint v1 ,  MOD   , Vint v2  when v2<>0 ->  Vint (v1 mod v2) 
 
             | Vint v1 , EQUAL   , Vint v2  ->  Vbool (v1 = v2) 
             | Vint v1 , DIFF    , Vint v2  ->  Vbool (v1 <> v2) 
             | Vint v1 ,  LESS   , Vint v2  ->  Vbool (v1 < v2) 
             | Vint v1 ,  GREAT  , Vint v2  ->  Vbool (v1 > v2) 
             | Vint v1 , LESSEQ  , Vint v2  ->  Vbool (v1 <= v2) 
             | Vint v1 , GREATEQ , Vint v2  ->  Vbool (v1 >= v2) 
 
             | Vbool v1 , AND , Vbool v2  ->  Vbool (v1 && v2) 
             | Vbool v1 , OR , Vbool v2  ->  Vbool (v1 || v2) 
 
             | Vstr v1 , PLUS , Vstr v2 -> Vstr (v1 ^ v2) 
             | _ , _ , _  -> runerr n  ;;
val eval_exp : int -> (string * value) list -> expression -> value = <fun>

Command evaluation

# let rec add v e env = match env with 
     [] -> [v,e]
   | (w,f)::l -> if w=v then (v,e)::l else (w,f)::(add v e l) ;;
val add : 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list = <fun>

# let print_value v = match v with 
     Vint n -> print_int n
   | Vbool true -> print_string "true"
   | Vbool false -> print_string "false"
   | Vstr s -> print_string s ;;
val print_value : value -> unit = <fun>

# let next_line state =
  let n = state.line+1 in
   if n < Array.length state.xprog then n else -1 ;;
val next_line : state_exec -> int = <fun>
# let eval_cmd state =
   match state.xprog.(state.line).cmd with 
     Rem _    ->  { state with line = next_line state }
   | Print e  ->  print_value (eval_exp state.line state.xenv e) ; 
                  print_newline () ;
                  { state with line = next_line state }
   | Let(v,e) ->  let ev = eval_exp state.line state.xenv e 
                    in { state with line = next_line state ; 
                                   xenv = add v ev state.xenv }
   | Goto n   ->  { state with line = n }
   | Input v  ->  let x = try read_int () 
                          with Failure "int_of_string" -> 0
                  in { state with line = next_line state; 
                                 xenv = add v (Vint x) state.xenv }
   | If (t,n) ->  match eval_exp state.line state.xenv t with 
                    Vbool true  -> { state with line = n }
                  | Vbool false -> { state with line = next_line state }
                  | _ -> runerr state.line  ;;
val eval_cmd : state_exec -> state_exec = <fun>

Program evaluation

# let rec run state = 
  if state.line = -1 then state else run (eval_cmd state) ;;
val run : state_exec -> state_exec = <fun>

Finishing touches

# let rec insert line p = match p with  
     [] -> [line]
   | l::prog -> 
       if l.num < line.num then l::(insert line prog)
       else if l.num=line.num then line::prog
       else line::l::prog ;;
val insert : line -> line list -> line list = <fun>

# let print_prog prog = 
   let print_line x = print_string (pp_line x) ; print_newline () in
    print_newline () ;
    List.iter print_line prog ;
    print_newline () ;;
val print_prog : line list -> unit = <fun>

# type loop_state = { prog:program; env:environment } ;;
# exception End ;;

# let one_command state =
   print_string "> " ; flush stdout ;
   try 
     match parse (input_line stdin) with 
        Line l -> { state with prog = insert l state.prog }
      | List  -> (print_prog state.prog ; state )
      | Run 
       -> let tprog = assemble state.prog in
          let xstate = run { line = 0; xprog = tprog; xenv = state.env } in
           {state with env = xstate.xenv }
      | PEnd -> raise End
   with 
       LexerError -> print_string "Illegal character\n"; state 
     | ParseError -> print_string "syntax error\n"; state 
     | RunError n -> 
         print_string "runtime error at line ";
         print_int n ;
         print_string "\n";  
         state ;;
val one_command : loop_state -> loop_state = <fun>

# let go () = 
 try 
   print_string "Mini-BASIC version 0.1\n\n";
   let rec loop state = loop (one_command state)  in 
     loop { prog = []; env = [] }
 with End -> print_string "See you later...\n";;
val go : unit -> unit = <fun>

Example: C+/C-

10 PRINT "Give the hidden number: "
20 INPUT N
30 PRINT "Give a number: "
40 INPUT R
50 IF R = N THEN 110
60 IF R < N THEN 90
70 PRINT "C-"
80 GOTO 30
90 PRINT "C+"
100 GOTO 30
110 PRINT "CONGRATULATIONS"

> RUN
Give the hidden number:
64
Give a number:
88
C-
Give a number:
44
C+
Give a number:
64
CONGRATULATIONS

Further work

1. Floating-point numbers: as is, our language only deals with integers, strings and booleans. Add floats, as well as the corresponding arithmetic operations in the language grammar. We need to modify not only parsing, but also evaluation, taking into account the implicit conversions between integers and floats.
   
   
2. Arrays: Add to the syntax the command DIM var[x] that declares an array var of size x, and the expression var[i] that references the ith element of the array var.
   
   
3. Toplevel directives: Add the toplevel directives SAVE "file_name" and LOAD "file_name" that save a Basic program to the hard disk, and load a Basic program from the hard disk, respectively.
   
   
4. Sub-program: Add sub-programs. The GOSUB line number command calls a sub-program by branching to the given line number while storing the line from where the call is made. The RETURN command resumes execution at the line following the last GOSUB call executed, if there is one, or exits the program otherwise. Adding sub-programs requires evaluation to manage not only the environement but also a stack containing the return addresses of the current GOSUB calls. The GOSUB command adds the possibility of defining recursive sub-programs.