diff options
Diffstat (limited to 'lib/syntax')
| -rw-r--r-- | lib/syntax/dead_end.ml | 49 | ||||
| -rw-r--r-- | lib/syntax/default.ml | 7 | ||||
| -rw-r--r-- | lib/syntax/t.ml | 57 | 
3 files changed, 112 insertions, 1 deletions
| diff --git a/lib/syntax/dead_end.ml b/lib/syntax/dead_end.ml new file mode 100644 index 0000000..78eadda --- /dev/null +++ b/lib/syntax/dead_end.ml @@ -0,0 +1,49 @@ +open StdLabels + +type pos = Lexing.position * Lexing.position +type ('a, 'b) variable = { pos : 'a; name : string; index : 'b option } + +module Expression = Default.Expression + +module Instruction = struct +  type repr = unit +  type expression = Expression.repr +  type variable = Expression.variable + +  (** Call for an instruction like [GT] or [*CLR] *) +  let call : pos -> string -> expression list -> repr = fun _ _ _ -> () + +  (** Label for a loop *) +  let location : pos -> string -> repr = fun _ _ -> () + +  (** Comment *) +  let comment : pos -> repr = fun _ -> () + +  (** Raw expression *) +  let expression : expression -> repr = fun _ -> () + +  type clause = pos * expression * repr list + +  let if_ : pos -> clause -> elifs:clause list -> else_:repr list -> repr = +   fun _ _ ~elifs ~else_ -> +    ignore elifs; +    ignore else_; +    () + +  let act : pos -> label:expression -> repr list -> repr = +   fun _ ~label _ -> +    ignore label; +    () + +  let assign : pos -> variable -> T.assignation_operator -> expression -> repr = +   fun _ _ _ _ -> () +end + +module Location = struct +  type repr = Instruction.repr +  type instruction = Instruction.repr + +  let location : pos -> instruction list -> repr = +   fun _pos instructions -> +    List.fold_left instructions ~init:() ~f:(fun () instruction -> instruction) +end diff --git a/lib/syntax/default.ml b/lib/syntax/default.ml index f4bc34e..9c5073c 100644 --- a/lib/syntax/default.ml +++ b/lib/syntax/default.ml @@ -1,3 +1,8 @@ +(** Default implementation which does nothing.  + +This module is expected to be used when you only need to implement an analyze +over a limited part of the whole syntax. *) +  type pos = Lexing.position * Lexing.position  type ('a, 'b) variable = { pos : 'a; name : string; index : 'b option } @@ -5,7 +10,7 @@ module Expression = struct    type 'a obs    type repr = unit -  type variable = { pos : pos; name : string; index : repr option } +  type variable    (**         Describe a variable, using the name in capitalized text, and an optionnal        index. diff --git a/lib/syntax/t.ml b/lib/syntax/t.ml index 9c25647..e9a901d 100644 --- a/lib/syntax/t.ml +++ b/lib/syntax/t.ml @@ -76,3 +76,60 @@ type function_ =    | Ucase'    | Val  [@@deriving eq, show] + +type keywords = +  | Inclib +  | Addobj +  | Cla +  | Clear +  | Clear' +  | Close +  | CloseAll +  | Cls +  | CmdClear +  | CopyArr +  | CurActs +  | CurActs' +  | CurLoc +  | CurLoc' +  | DelAct +  | FreeLib +  | DelObj +  | Dynamic +  | Exec +  | Exit +  | Gosub +  | Goto +  | IncLib +  | Jump +  | KillAll +  | KillObj +  | KillVar +  | MainTxt +  | MainTxt' +  | Menu +  | Msg +  | Nl +  | Nl' +  | P +  | P' +  | Play +  | Play' +  | RefInt +  | SaveGame +  | SelAct' +  | SelObj +  | SelObj' +  | SetTimer +  | ShowActs +  | ShowInput +  | ShowObjs +  | ShowStat +  | Unselect +  | UseHTML +  | UserCom' +  | UserText +  | UserText' +  | View +  | Wait +  | XGoto | 
