st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-06 14:58:50 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Pattern-matching parsing

Browse source
This commit is contained in:
Dmitry Boulytchev 2018-05-01 02:57:09 +03:00
parent 3f40a66f43
commit de760a2b09
3 changed files with 50 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

9
src/Driver.ml
View file

@ -8,7 +8,14 @@ let parse infile =
inherit Util.Lexers.decimal s
inherit Util.Lexers.string s
inherit Util.Lexers.char s
inherit Util.Lexers.ident ["skip"; "if"; "then"; "else"; "elif"; "fi"; "while"; "do"; "od"; "repeat"; "until"; "for"; "fun"; "local"; "return"; "length"] s
inherit Util.Lexers.ident ["skip";
"if"; "then"; "else"; "elif"; "fi";
"while"; "do"; "od";
"repeat"; "until";
"for";
"fun"; "local"; "return";
"length";
"case"; "of"; "esac"; "when"] s
inherit Util.Lexers.skip [
Matcher.Skip.whitespaces " \t\n";
Matcher.Skip.lineComment "--";

40
src/Language.ml
View file

@ -25,6 +25,7 @@ module Value =
| Array a -> a
| _ -> failwith "array value expected"
let sexp s vs = Sexp (s, vs)
let of_int n = Int n
let of_string s = String s
let of_array a = Array a
@ -226,16 +227,48 @@ module Expr =
module Stmt =
struct
(* Patterns in statements *)
module Pattern =
struct
(* The type for patterns *)
@type t =
(* wildcard "-" *) | Wildcard
(* S-expression *) | Sexp of string * t list
(* identifier *) | Ident of string
(* constant *) | Const of int
(* string *) | String of string
(* array *) | Array of t list
(* arbitrary array *) | IsArray
(* arbitrary string *) | IsString
with show
(* Pattern parser *)
ostap (
parse:
%"_" {Wildcard}
| "`" t:IDENT ps:(-"(" !(Util.list)[parse] -")")? {Sexp (t, match ps with None -> [] | Some ps -> ps)}
| x:IDENT {Ident x}
| n:DECIMAL {Const n}
| s:STRING {String s}
| a:(-"[" !(Util.list)[parse] -"]") {Array a}
| "#" "[" "]" {IsArray}
| "#" {IsString}
)
end
(* The type for statements *)
type t =
@type t =
(* assignment *) | Assign of string * Expr.t list * Expr.t
(* composition *) | Seq of t * t
(* empty statement *) | Skip
(* conditional *) | If of Expr.t * t * t
(* loop with a pre-condition *) | While of Expr.t * t
(* loop with a post-condition *) | Repeat of t * Expr.t
(* pattern-matching *) | Case of Expr.t * (Pattern.t * Expr.t option * t) list
(* return statement *) | Return of Expr.t option
(* call a procedure *) | Call of string * Expr.t list
(* call a procedure *) | Call of string * Expr.t list with show
(* Statement evaluator
@ -299,7 +332,8 @@ module Stmt =
Seq (i, While (c, Seq (b, s)))
}
| %"repeat" s:parse %"until" e:!(Expr.parse) {Repeat (s, e)}
| %"return" e:!(Expr.parse)? {Return e}
| %"return" e:!(Expr.parse)? {Return e}
| %"case" e:!(Expr.parse) %"of" bs:!(Util.listBy)[ostap ("|")][ostap (!(Pattern.parse) (-"when" !(Expr.parse))? parse)] %"esac" {Case (e, bs)}
| x:IDENT
s:(is:(-"[" !(Expr.parse) -"]")* ":=" e :!(Expr.parse) {Assign (x, is, e)} |
"(" args:!(Util.list0)[Expr.parse] ")" {Call (x, args)}

6
src/SM.ml
View file

@ -5,7 +5,8 @@ open Language
@type insn =
(* binary operator *) | BINOP of string
(* put a constant on the stack *) | CONST of int
(* put a string on the stack *) | STRING of string
(* put a string on the stack *) | STRING of string
(* create an S-expression *) | SEXP of string * int
(* load a variable to the stack *) | LD of string
(* store a variable from the stack *) | ST of string
(* store in an array *) | STA of string * int
@ -48,6 +49,8 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
| BINOP op -> let y::x::stack' = stack in eval env (cstack, (Value.of_int @@ Expr.to_func op (Value.to_int x) (Value.to_int y)) :: stack', c) prg'
| CONST i -> eval env (cstack, (Value.of_int i)::stack, c) prg'
| STRING s -> eval env (cstack, (Value.of_string s)::stack, c) prg'
| SEXP (s, n) -> let vs, stack' = split n stack in
eval env (cstack, (Value.sexp s @@ List.rev vs)::stack', c) prg'
| LD x -> eval env (cstack, State.eval st x :: stack, c) prg'
| ST x -> let z::stack' = stack in eval env (cstack, stack', (State.update x z st, i, o)) prg'
| STA (x, n) -> let v::is, stack' = split (n+1) stack in
@ -120,6 +123,7 @@ let compile (defs, p) =
| Expr.Binop (op, x, y) -> expr x @ expr y @ [BINOP op]
| Expr.Call (f, args) -> call f args false
| Expr.Array xs -> List.flatten (List.map expr xs) @ [CALL (".array", List.length xs, false)]
| Expr.Sexp (t, xs) -> List.flatten (List.map expr xs) @ [CALL (".array", List.length xs, false)]
| Expr.Elem (a, i) -> expr a @ expr i @ [CALL (".elem", 2, false)]
| Expr.Length e -> expr e @ [CALL (".length", 1, false)]
in