diff options
Diffstat (limited to 'syntax')
| -rw-r--r-- | syntax/S.ml | 91 | ||||
| -rw-r--r-- | syntax/dune | 6 | ||||
| -rw-r--r-- | syntax/t.ml | 77 | ||||
| -rw-r--r-- | syntax/tree.ml | 95 | ||||
| -rw-r--r-- | syntax/tree.mli | 51 |
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 |