From e16fb72a9ea78892baffa38426ceca8fb1829de1 Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Thu, 7 Mar 2019 21:12:43 +0300 Subject: [PATCH] List notations/pattern matching --- regression/orig/test051.log | 8 +++++ regression/test051.expr | 28 ++++++++++++++++ regression/test051.input | 1 + regression/x86only/orig/test003.log | 4 +++ regression/x86only/test003.expr | 10 ++++++ regression/x86only/test003.input | 1 + runtime/runtime.c | 44 ++++++++++++++++++------ src/Language.ml | 52 ++++++++++++++++++++++++----- 8 files changed, 128 insertions(+), 20 deletions(-) create mode 100644 regression/orig/test051.log create mode 100644 regression/test051.expr create mode 100644 regression/test051.input create mode 100644 regression/x86only/orig/test003.log create mode 100644 regression/x86only/test003.expr create mode 100644 regression/x86only/test003.input diff --git a/regression/orig/test051.log b/regression/orig/test051.log new file mode 100644 index 000000000..1da1496d0 --- /dev/null +++ b/regression/orig/test051.log @@ -0,0 +1,8 @@ +> 0 +15 +15 +1 +2 +3 +4 +5 diff --git a/regression/test051.expr b/regression/test051.expr new file mode 100644 index 000000000..4fd56699a --- /dev/null +++ b/regression/test051.expr @@ -0,0 +1,28 @@ +fun sum (l) { + case l of + {} -> return 0 + | h : t -> return (h + sum (t)) + esac +} + +fun print_list (l) { + case l of + {} -> skip + | h : t -> write (h); print_list (t) + esac +} + +fun array_to_list (a) local l, i { + l := {}; + for i := a.length, i > 0, i := i-1 do + l := a[i-1] : l + od; + return l +} + +n := read (); +write (sum ({})); +write (sum ({1, 2, 3, 4, 5})); +write (sum (1:2:3:4:5:{})); +print_list (array_to_list ([1, 2, 3, 4, 5])) + diff --git a/regression/test051.input b/regression/test051.input new file mode 100644 index 000000000..573541ac9 --- /dev/null +++ b/regression/test051.input @@ -0,0 +1 @@ +0 diff --git a/regression/x86only/orig/test003.log b/regression/x86only/orig/test003.log new file mode 100644 index 000000000..663d7b156 --- /dev/null +++ b/regression/x86only/orig/test003.log @@ -0,0 +1,4 @@ +0 +{1, 2, 3, 4} +{{1}, {2, 3}, {4, {5, 6}}} +{1, 2, 3, 4} diff --git a/regression/x86only/test003.expr b/regression/x86only/test003.expr new file mode 100644 index 000000000..0d8b8a442 --- /dev/null +++ b/regression/x86only/test003.expr @@ -0,0 +1,10 @@ +lists := [ + {}, + {1, 2, 3, 4}, + {{1}, {2, 3}, {4, {5, 6}}}, + 1 : 2 : 3 : 4 : {} +]; + +for i := 0, itag)); - if (LEN(a->tag)) { - printStringBuf (" ("); - for (i = 0; i < LEN(a->tag); i++) { - printValue ((void*)((int*) a->contents)[i]); - if (i != LEN(a->tag) - 1) printStringBuf (", "); + case SEXP_TAG: { + char * tag = de_hash (TO_SEXP(p)->tag); + + if (strcmp (tag, "cons") == 0) { + data *b = a; + + printStringBuf ("{"); + + while (LEN(a->tag)) { + printValue ((void*)((int*) b->contents)[0]); + b = (data*)((int*) b->contents)[1]; + if (! UNBOXED(b)) { + printStringBuf (", "); + b = TO_DATA(b); + } + else break; } - printStringBuf (")"); + + printStringBuf ("}"); } - break; + else { + printStringBuf ("%s", tag); + if (LEN(a->tag)) { + printStringBuf (" ("); + for (i = 0; i < LEN(a->tag); i++) { + printValue ((void*)((int*) a->contents)[i]); + if (i != LEN(a->tag) - 1) printStringBuf (", "); + } + printStringBuf (")"); + } + } + } + break; default: printStringBuf ("*** invalid tag: %x ***", TAG(a->tag)); @@ -485,7 +507,7 @@ static void extend_spaces (void) { void *p1 = mremap(from_space.begin, SPACE_SIZE, 2*SPACE_SIZE, 0); void *p2 = mremap(to_space.begin , SPACE_SIZE, 2*SPACE_SIZE, 0); if (p1 == MAP_FAILED || p2 == MAP_FAILED) { - perror("EROOR: extend_spaces: mmap failed\n"); + perror("ERROR: extend_spaces: mmap failed\n"); exit (1); } #ifdef DEBUG_PRINT @@ -623,7 +645,7 @@ extern void init_pool (void) { MAP_PRIVATE | MAP_ANONYMOUS | MAP_32BIT, -1, 0); if (to_space.begin == MAP_FAILED || from_space.begin == MAP_FAILED) { - perror("EROOR: init_pool: mmap failed\n"); + perror("ERROR: init_pool: mmap failed\n"); exit (1); } from_space.current = from_space.begin; diff --git a/src/Language.ml b/src/Language.ml index 618e00720..849e9bd3d 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -46,7 +46,21 @@ module Value = | Array a -> let n = Array.length a in append "["; Array.iteri (fun i a -> (if i > 0 then append ", "); inner a) a; append "]" | Sexp (t, a) -> let n = List.length a in - append t; (if n > 0 then (append " ("; List.iteri (fun i a -> (if i > 0 then append ", "); inner a) a; append ")")) + if t = "cons" + then ( + append "{"; + let rec inner_list = function + | [] -> () + | [x; Int 0] -> inner x + | [x; Sexp ("cons", a)] -> inner x; append ", "; inner_list a + in inner_list a; + append "}" + ) + else ( + append t; + (if n > 0 then (append " ("; List.iteri (fun i a -> (if i > 0 then append ", "); inner a) a; + append ")")) + ) in inner v; Bytes.of_string @@ Buffer.contents buf @@ -252,17 +266,19 @@ module Expr = List.map (fun s -> ostap(- $(s)), (fun x y -> match s with + | ":" -> Sexp ("cons", [x; y]) | "++" -> Call ("strcat", [x; y]) | _ -> Binop (s, x, y) ) ) s ) - [| - `Lefta, ["!!"]; - `Lefta, ["&&"]; - `Nona , ["=="; "!="; "<="; "<"; ">="; ">"]; - `Lefta, ["++"; "+" ; "-"]; - `Lefta, ["*" ; "/"; "%"]; + [| + `Righta, [":"]; + `Lefta , ["!!"]; + `Lefta , ["&&"]; + `Nona , ["=="; "!="; "<="; "<"; ">="; ">"]; + `Lefta , ["++"; "+" ; "-"]; + `Lefta , ["*" ; "/"; "%"]; |] ) primary); @@ -273,6 +289,10 @@ module Expr = | s:STRING {String (String.sub s 1 (String.length s - 2))} | c:CHAR {Const (Char.code c)} | "[" es:!(Util.list0)[parse] "]" {Array es} + | "{" es:!(Util.list0)[parse] "}" {match es with + | [] -> Const 0 + | _ -> List.fold_right (fun x acc -> Sexp ("cons", [x; acc])) es (Const 0) + } | t:UIDENT args:(-"(" !(Util.list)[parse] -")")? {Sexp (t, match args with None -> [] | Some args -> args)} | x:LIDENT s:("(" args:!(Util.list0)[parse] ")" {Call (x, args)} | empty {Var x}) {s} | -"(" parse -")" @@ -305,10 +325,23 @@ module Stmt = (* Pattern parser *) ostap ( - parse: - %"_" {Wildcard} + parse: + !(Ostap.Util.expr + (fun x -> x) + (Array.map (fun (a, s) -> + a, + List.map (fun s -> ostap(- $(s)), (fun x y -> Sexp ("cons", [x; y]))) s) + [|`Righta, [":"]|] + ) + primary); + primary: + %"_" {Wildcard} | t:UIDENT ps:(-"(" !(Util.list)[parse] -")")? {Sexp (t, match ps with None -> [] | Some ps -> ps)} | "[" ps:(!(Util.list0)[parse]) "]" {Array ps} + | "{" ps:(!(Util.list0)[parse]) "}" {match ps with + | [] -> UnBoxed + | _ -> List.fold_right (fun x acc -> Sexp ("cons", [x; acc])) ps UnBoxed + } | x:LIDENT y:(-"@" parse)? {match y with None -> Named (x, Wildcard) | Some y -> Named (x, y)} | c:DECIMAL {Const c} | s:STRING {String (String.sub s 1 (String.length s - 2))} @@ -318,6 +351,7 @@ module Stmt = | "#" %"string" {StringTag} | "#" %"sexp" {SexpTag} | "#" %"array" {ArrayTag} + | -"(" parse -")" ) let vars p = transform(t) (fun f -> object inherit [string list, _] @t[foldl] f method c_Named s _ name p = name :: f s p end) [] p