Merged

src/Language.ml

@@ -0,0 +1,130 @@
+(* Opening a library for generic programming (https://github.com/dboulytchev/GT).
+   The library provides "@type ..." syntax extension and plugins like show, etc.
+*)
+open GT
+
+(* Opening a library for combinator-based syntax analysis *)
+open Ostap.Combinators
+       
+(* Simple expressions: syntax and semantics *)
+module Expr =
+  struct
+    
+    (* The type for expressions. Note, in regular OCaml there is no "@type..." 
+       notation, it came from GT. 
+    *)
+    @type t =
+    (* integer constant *) | Const of int
+    (* variable         *) | Var   of string
+    (* binary operator  *) | Binop of string * t * t with show
+
+    (* Available binary operators:
+        !!                   --- disjunction
+        &&                   --- conjunction
+        ==, !=, <=, <, >=, > --- comparisons
+        +, -                 --- addition, subtraction
+        *, /, %              --- multiplication, division, reminder
+    *)
+                                                            
+    (* State: a partial map from variables to integer values. *)
+    type state = string -> int 
+
+    (* Empty state: maps every variable into nothing. *)
+    let empty = fun x -> failwith (Printf.sprintf "Undefined variable %s" x)
+
+    (* Update: non-destructively "modifies" the state s by binding the variable x 
+      to value v and returns the new state.
+    *)
+    let update x v s = fun y -> if x = y then v else s y
+
+    (* Expression evaluator
+
+          val eval : state -> t -> int
+ 
+       Takes a state and an expression, and returns the value of the expression in 
+       the given state.
+     *)
+                                                       
+    let to_func op =
+      let bti   = function true -> 1 | _ -> 0 in
+      let itb b = b <> 0 in
+      let (|>) f g   = fun x y -> f (g x y) in
+      match op with
+      | "+"  -> (+)
+      | "-"  -> (-)
+      | "*"  -> ( * )
+      | "/"  -> (/)
+      | "%"  -> (mod)
+      | "<"  -> bti |> (< )
+      | "<=" -> bti |> (<=)
+      | ">"  -> bti |> (> )
+      | ">=" -> bti |> (>=)
+      | "==" -> bti |> (= )
+      | "!=" -> bti |> (<>)
+      | "&&" -> fun x y -> bti (itb x && itb y)
+      | "!!" -> fun x y -> bti (itb x || itb y)
+      | _    -> failwith (Printf.sprintf "Unknown binary operator %s" op)    
+    
+    let rec eval st expr =      
+      match expr with
+      | Const n -> n
+      | Var   x -> st x
+      | Binop (op, x, y) -> to_func op (eval st x) (eval st y)
+
+    (* Statement parser *)
+    ostap (
+      parse: empty {failwith "Not implemented yet"}
+    )
+
+  end
+                    
+(* Simple statements: syntax and sematics *)
+module Stmt =
+  struct
+
+    (* The type for statements *)
+    @type t =
+    (* read into the variable           *) | Read   of string
+    (* write the value of an expression *) | Write  of Expr.t
+    (* assignment                       *) | Assign of string * Expr.t
+    (* composition                      *) | Seq    of t * t with show
+
+    (* The type of configuration: a state, an input stream, an output stream *)
+    type config = Expr.state * int list * int list 
+
+    (* Statement evaluator
+
+          val eval : config -> t -> config
+
+       Takes a configuration and a statement, and returns another configuration
+    *)
+    let rec eval ((st, i, o) as conf) stmt =
+      match stmt with
+      | Read    x       -> (match i with z::i' -> (Expr.update x z st, i', o) | _ -> failwith "Unexpected end of input")
+      | Write   e       -> (st, i, o @ [Expr.eval st e])
+      | Assign (x, e)   -> (Expr.update x (Expr.eval st e) st, i, o)
+      | Seq    (s1, s2) -> eval (eval conf s1) s2
+                                
+    (* Statement parser *)
+    ostap (
+      parse: empty {failwith "Not implemented yet"}
+    )
+      
+  end
+
+(* The top-level definitions *)
+
+(* The top-level syntax category is statement *)
+type t = Stmt.t    
+
+(* Top-level evaluator
+
+     eval : t -> int list -> int list
+
+   Takes a program and its input stream, and returns the output stream
+*)
+let eval p i =
+  let _, _, o = Stmt.eval (Expr.empty, i, []) p in o
+
+(* Top-level parser *)
+let parse = Stmt.parse