List notations/pattern matching

regression/orig/test051.log

@@ -0,0 +1,8 @@
+> 0
+15
+15
+1
+2
+3
+4
+5

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]))
+

regression/test051.input

@@ -0,0 +1 @@
+0

regression/x86only/orig/test003.log

@@ -0,0 +1,4 @@
+0
+{1, 2, 3, 4}
+{{1}, {2, 3}, {4, {5, 6}}}
+{1, 2, 3, 4}

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, i<lists.length, i:=i+1 do
+  printf ("%s\n", lists[i].string)
+od

regression/x86only/test003.input

@@ -0,0 +1 @@
+0

runtime/runtime.c

@@ -134,17 +134,39 @@ static void printValue (void *p) {
       printStringBuf ("]");
       break;
       
-    case SEXP_TAG:
+    case SEXP_TAG: {
-      printStringBuf ("%s", de_hash (TO_SEXP(p)->tag));
+      char * tag = de_hash (TO_SEXP(p)->tag);
-      if (LEN(a->tag)) {
+      
-	printStringBuf (" (");
+      if (strcmp (tag, "cons") == 0) {
-	for (i = 0; i < LEN(a->tag); i++) {
+	data *b = a;
-	  printValue ((void*)((int*) a->contents)[i]);
+	
-	  if (i != LEN(a->tag) - 1) printStringBuf (", ");
+	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;

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, ["!!"];
+                `Righta, [":"];  
-		`Lefta, ["&&"];
+		`Lefta , ["!!"];
-		`Nona , ["=="; "!="; "<="; "<"; ">="; ">"];
+		`Lefta , ["&&"];
-		`Lefta, ["++"; "+" ; "-"];
+		`Nona  , ["=="; "!="; "<="; "<"; ">="; ">"];
-		`Lefta, ["*" ; "/"; "%"];
+		`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:
+          parse: 
-            %"_" {Wildcard}
+	  !(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