fork download
copy 
  1. (* Implementation of a simple, command-oriented language. *)
  2.  
  3.  
  4. (* grammar ------------------------------------------------------------------ *)
  5. (*
  6.  BNF grammar for this simple language:
  7.   <exp> ::= 
  8.          |  <X>
  9.          |  <exp> + <exp>
  10.          |  <exp> * <exp>
  11.          |  <exp> < <exp>
  12.          |  <integer constant>
  13.          |  (<exp>)
  14.  
  15.   <cmd> ::= 
  16.          |  skip
  17.          |  <X> = <exp>
  18.          |  ifNZ <exp> { <cmd> } else { <cmd> }
  19.          |  whileNZ <exp> { <cmd> }
  20.          |  <cmd>; <cmd>
  21. *)
  22.  
  23. (* Abstract Syntax (AST) ---------------------------------------------------- *)
  24.  
  25. type var = string
  26.  
  27. type exp =
  28.   | Var of var
  29.   | Add of (exp * exp)
  30.   | Mul of (exp * exp)
  31.   | Lt  of (exp * exp)
  32.   | Lit of int
  33.  
  34. type cmd =
  35.   | Skip
  36.   | Assn    of var * exp
  37.   | IfNZ    of exp * cmd * cmd
  38.   | WhileNZ of exp * cmd
  39.   | Seq     of cmd * cmd
  40.  
  41.  
  42.  
  43. (* AST for Factorial Example ------------------------------------------------ *)
  44. (*
  45.         X = 6;
  46. 	ANS = 1;
  47. 	whileNZ (x) {
  48.   		ANS = ANS * X;
  49.   		X = X + -1;
  50. 	} 
  51.  *)
  52.  
  53. let factorial : cmd =
  54.   let x = "X" in
  55.   let ans = "ANS" in
  56.   Seq (Assn (x, Lit 6),
  57.        Seq (Assn (ans, Lit 1),
  58.             WhileNZ(Var x,
  59.                     Seq (Assn(ans, Mul(Var ans, Var x)),
  60.                          Assn(x, Add(Var x, Lit (-1)))))))
  61.  
  62. (* Interpreter -------------------------------------------------------------- *)
  63.  
  64. type state = var -> int
  65.  
  66. let rec interpret_exp (s:state) (e:exp) : int =
  67.   match e with
  68.   | Var x -> s x
  69.   | Add (e1, e2) -> (interpret_exp s e1) + (interpret_exp s e2)
  70.   | Mul (e1, e2) -> (interpret_exp s e1) * (interpret_exp s e2)
  71.   | Lt  (e1, e2) -> if (interpret_exp s e1) < (interpret_exp s e2) then 1 else 0
  72.   | Lit n -> n
  73.  
  74. let update s x v =
  75.   fun y -> if x = y then v else s y
  76.  
  77. let rec interpret_cmd (s:state) (c:cmd) : state =
  78.   match c with
  79.   | Skip -> s
  80.   | Assn (x, e1) ->
  81.     let v = interpret_exp s e1 in
  82.     update s x v
  83.   | IfNZ (e1, c1, c2) ->
  84.     if (interpret_exp s e1) = 0 then interpret_cmd s c2 else interpret_cmd s c1
  85.   | WhileNZ (e, c) ->
  86.     if (interpret_exp s e) = 0 then s else interpret_cmd s (Seq(c, WhileNZ (e, c)))
  87.   | Seq (c1, c2) ->
  88.     let s1 = interpret_cmd s c1 in
  89.     interpret_cmd s1 c2
  90.  
  91. let init_state : state = fun _ -> 0
  92.  
  93.  
Success #stdin #stdout 0.01s 5320KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/MEd1Rb
language:
OCaml (ocamlopt 4.05.0)
created:
4 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!