first commit

5 files changed, 320 insertions, 0 deletions

diff --git a/syntax/S.ml b/syntax/S.ml
new file mode 100644
index 0000000..3873eed
--- /dev/null
+++ b/syntax/S.ml
@@ -0,0 +1,91 @@
+(** 
+    This module describe the type an analyzer must implement in order to be
+    used with the parser. 
+
+    The module is divided in three modules :
+        - Expression : the finest part of the QSP syntax.
+        - Instruction : if/act block, 
+        - Location
+
+    All the elements of the syntax are represented with a dedicated function
+    (instead of a big sum type). The module [Tree] provide an implementation
+    which build the AST.
+
+ *)
+
+type pos = Lexing.position * Lexing.position
+type ('a, 'b) variable = { pos : 'a; name : string; index : 'b option }
+
+(** Represent the evaluation over an expression *)
+module type Expression = sig
+  type 'a obs
+  type repr
+
+  type variable = { pos : pos; name : string; index : repr option }
+  (** 
+      Describe a variable, using the name in capitalized text, and an optionnal
+      index.
+
+      If missing, the index should be considered as [0].
+   *)
+
+  val ident : variable -> repr
+
+  (*
+        Basic values, text, number…
+   *)
+
+  val integer : pos -> string -> repr
+  val literal : pos -> string -> repr
+
+  val function_ : pos -> T.function_ -> repr list -> repr
+  (** Call a function. The functions list is hardcoded in lib/lexer.mll *)
+
+  val uoperator : pos -> T.uoperator -> repr -> repr
+  (** Unary operator like [-123] or [+'Text']*)
+
+  val boperator : pos -> T.boperator -> repr -> repr -> repr
+  (** Binary operator, for a comparaison, or an operation *)
+end
+
+module type Instruction = sig
+  type repr
+  type expression
+  type variable
+
+  val call : pos -> string -> expression list -> repr
+  (** Call for an instruction like [GT] or [*CLR] *)
+
+  val location : pos -> string -> repr
+  (** Label for a loop *)
+
+  val comment : pos -> repr
+  (** Comment *)
+
+  val expression : expression -> repr
+  (** Raw expression *)
+
+  type clause = pos * expression * repr list
+
+  val if_ : pos -> clause -> elifs:clause list -> else_:repr list -> repr
+  val act : pos -> label:expression -> repr list -> repr
+  val assign : pos -> variable -> T.assignation_operator -> expression -> repr
+end
+
+module type Location = sig
+  type repr
+  type instruction
+
+  val location : pos -> instruction list -> repr
+end
+
+module type Analyzer = sig
+  module Expression : Expression
+
+  module Instruction :
+    Instruction
+      with type expression = Expression.repr
+       and type variable = Expression.variable
+
+  module Location : Location with type instruction = Instruction.repr
+end
diff --git a/syntax/dune b/syntax/dune
new file mode 100644
index 0000000..8188de8
--- /dev/null
+++ b/syntax/dune
@@ -0,0 +1,6 @@
+(library
+ (name qsp_syntax)
+ 
+ (preprocess (pps 
+   ppx_deriving.show 
+   ppx_deriving.eq )))
diff --git a/syntax/t.ml b/syntax/t.ml
new file mode 100644
index 0000000..12be4b4
--- /dev/null
+++ b/syntax/t.ml
@@ -0,0 +1,77 @@
+(**
+    This module contains the basic operators used in the QSP syntax.
+ *)
+
+type boperator =
+  | Eq
+  | Neq
+  | Plus
+  | Minus
+  | Product
+  | Div
+  | Gt
+  | Lt
+  | Gte
+  | Lte
+  | And
+  | Or
+  | Mod
+[@@deriving eq, show]
+
+and uoperator = No | Neg | Add [@@deriving eq, show]
+
+and assignation_operator = Eq' | Inc  (** += *) | Decr  (** -= *)
+[@@deriving eq, show]
+
+type function_ =
+  | Arrcomp
+  | Arrpos
+  | Arrsize
+  | Countobj
+  | Desc
+  | Desc'
+  | Dyneval
+  | Dyneval'
+  | Func
+  | Func'
+  | Getobj
+  | Getobj'
+  | Iif
+  | Iif'
+  | Input
+  | Input'
+  | Instr
+  | Isnum
+  | Isplay
+  | Lcase
+  | Lcase'
+  | Len
+  | Max
+  | Max'
+  | Mid
+  | Mid'
+  | Min
+  | Min'
+  | Msecscount
+  | Qspver
+  | Qspver'
+  | Rand
+  | Replace
+  | Replace'
+  | Rgb
+  | Rnd
+  | Selact
+  | Stattxt
+  | Stattxt'
+  | Str
+  | Str'
+  | Strcomp
+  | Strfind
+  | Strfind'
+  | Strpos
+  | Trim
+  | Trim'
+  | Ucase
+  | Ucase'
+  | Val
+[@@deriving eq, show]
diff --git a/syntax/tree.ml b/syntax/tree.ml
new file mode 100644
index 0000000..bb31253
--- /dev/null
+++ b/syntax/tree.ml
@@ -0,0 +1,95 @@
+type pos = Lexing.position * Lexing.position
+
+module Ast = struct
+  type nonrec pos = pos
+
+  type 'a variable = { pos : 'a; name : string; index : 'a expression option }
+  [@@deriving eq, show]
+
+  and 'a expression =
+    | Integer of 'a * string
+    | Literal of 'a * string
+    | Ident of 'a variable
+    | BinaryOp of 'a * T.boperator * 'a expression * 'a expression
+    | Op of 'a * T.uoperator * 'a expression
+    | Function of 'a * T.function_ * 'a expression list
+  [@@deriving eq, show]
+
+  and 'a condition = 'a * 'a expression * 'a statement list
+
+  and 'a statement =
+    | If of {
+        loc : 'a;
+        then_ : 'a condition;
+        elifs : 'a condition list;
+        else_ : 'a statement list;
+      }
+    | Act of { loc : 'a; label : 'a expression; statements : 'a statement list }
+    | Declaration of ('a * 'a variable * T.assignation_operator * 'a expression)
+    | Expression of 'a expression
+    | Comment of 'a
+    | Call of 'a * string * 'a expression list
+    | Location of 'a * string
+  [@@deriving eq, show]
+end
+
+(** Default implementation for the expression *)
+module Expression : S.Expression with type repr = pos Ast.expression = struct
+  type 'a obs
+  type repr = pos Ast.expression
+  type variable = { pos : pos; name : string; index : repr option }
+
+  let integer : pos -> string -> repr = fun pos i -> Ast.Integer (pos, i)
+  let literal : pos -> string -> repr = fun pos l -> Ast.Literal (pos, l)
+
+  let function_ : pos -> T.function_ -> repr list -> repr =
+   fun pos name args -> Ast.Function (pos, name, args)
+
+  let uoperator : pos -> T.uoperator -> repr -> repr =
+   fun pos op expression -> Ast.Op (pos, op, expression)
+
+  let boperator : pos -> T.boperator -> repr -> repr -> repr =
+   fun pos op op1 op2 -> Ast.BinaryOp (pos, op, op1, op2)
+
+  let ident : variable -> repr =
+   fun { pos; name; index } -> Ast.Ident { pos; name; index }
+end
+
+module Instruction :
+  S.Instruction
+    with type expression = Expression.repr
+     and type repr = pos Ast.statement
+     and type variable = Expression.variable = struct
+  type repr = pos Ast.statement
+  type expression = Expression.repr
+  type variable = Expression.variable
+
+  let call : pos -> string -> expression list -> repr =
+   fun pos name args -> Ast.Call (pos, name, args)
+
+  let location : pos -> string -> repr =
+   fun loc label -> Ast.Location (loc, label)
+
+  let comment : pos -> repr = fun pos -> Ast.Comment pos
+  let expression : expression -> repr = fun expr -> Ast.Expression expr
+
+  type clause = pos * expression * repr list
+
+  let if_ : pos -> clause -> elifs:clause list -> else_:repr list -> repr =
+   fun pos predicate ~elifs ~else_ ->
+    Ast.If { loc = pos; then_ = predicate; elifs; else_ }
+
+  let act : pos -> label:expression -> repr list -> repr =
+   fun pos ~label statements -> Ast.Act { loc = pos; label; statements }
+
+  let assign : pos -> variable -> T.assignation_operator -> expression -> repr =
+   fun pos_loc { pos; name; index } op expr ->
+    Ast.Declaration (pos_loc, { pos; name; index }, op, expr)
+end
+
+module Location = struct
+  type instruction = pos Ast.statement
+  type repr = pos * instruction list
+
+  let location : pos -> instruction list -> repr = fun pos block -> (pos, block)
+end
diff --git a/syntax/tree.mli b/syntax/tree.mli
new file mode 100644
index 0000000..ca5a639
--- /dev/null
+++ b/syntax/tree.mli
@@ -0,0 +1,51 @@
+(** 
+    Implementation for S.Analyzer for building a complete Ast.
+
+    Used in the unit test in order to check if the grammar is interpreted as
+    expected, not really usefull over a big qsp.
+ *)
+
+(** This module is the result of the evaluation. *)
+module Ast : sig
+  type pos = Lexing.position * Lexing.position
+
+  type 'a variable = { pos : 'a; name : string; index : 'a expression option }
+  [@@deriving eq, show]
+  (** A variable, used both in an expression (reference) or in a statement
+      (assignation) *)
+
+  and 'a expression =
+    | Integer of 'a * string
+    | Literal of 'a * string
+    | Ident of 'a variable
+    | BinaryOp of 'a * T.boperator * 'a expression * 'a expression
+    | Op of 'a * T.uoperator * 'a expression
+    | Function of 'a * T.function_ * 'a expression list
+  [@@deriving eq, show]
+
+  and 'a condition = 'a * 'a expression * 'a statement list
+  (** A condition in if or elseif statement *)
+
+  and 'a statement =
+    | If of {
+        loc : 'a;
+        then_ : 'a condition;
+        elifs : 'a condition list;
+        else_ : 'a statement list;
+      }
+    | Act of { loc : 'a; label : 'a expression; statements : 'a statement list }
+    | Declaration of ('a * 'a variable * T.assignation_operator * 'a expression)
+    | Expression of 'a expression
+    | Comment of 'a
+    | Call of 'a * string * 'a expression list
+    | Location of 'a * string
+  [@@deriving eq, show]
+end
+
+(** / **)
+
+include
+  S.Analyzer
+    with type Expression.repr = Ast.pos Ast.expression
+     and type Instruction.repr = Ast.pos Ast.statement
+     and type Location.repr = Ast.pos * Ast.pos Ast.statement list