Removed unneeded returns from stdlib (yu-yu\!)

stdlib/Collection.expr

@@ -0,0 +1,110 @@
+-- MNode (key, list of values, balance factor, left subtree, right subtree)
+-- balance factor = height (left subtree) - height (right subtree)
+
+public fun insert (m, k, v) {
+  fun rot (left, node) {
+    if left
+    then case node of
+           MNode (k, v, _, l, MNode (rk, rv, _, ll, rr)) ->
+             MNode (rk, rv, 0, MNode (k, v, 0, l, ll), rr)
+         esac
+    else case node of
+           MNode (k, v, _, MNode (lk, lv, _, ll, rr), r) ->
+             MNode (lk, lv, 0, ll, MNode (k, v, 0, rr, r))
+         esac
+    fi
+  }
+
+  fun factor (x) {x [2]}
+  
+  fun inner (m, k, v) {
+    case m of
+      {} -> [true, MNode (k, {v}, 0, {}, {})]
+    | MNode (kk, vv, bf, l, r) -> 
+       local c = compare (k, kk);
+       if c == 0
+       then [false, MNode (kk, v : vv, bf, l, r)]
+       else if c < 0
+            then
+              case inner (l, k, v) of
+                [true,  ll] -> if bf < 0
+	                       then [false, MNode (kk, vv, bf + 1, ll, r)]
+	                       elif bf == 1
+			       then if ll.factor > 0
+			            then [false, rot (false, MNode (kk, vv, bf, ll, r))]
+			            else [false, rot (false, MNode (kk, vv, bf, rot (true, ll), r))]
+			            fi
+			       else [true,  MNode (kk, vv, bf + 1, ll, r)] 
+			       fi
+              | [false, ll] -> [false, MNode (kk, vv, bf, ll, r)]
+	      esac		
+            else
+	      case inner (r, k, v) of
+	        [true,  rr] -> if bf > 0
+	                       then [false, MNode (kk, vv, bf - 1, l, rr)]
+			       elif bf == -1
+			       then if rr.factor < 0
+			            then [false, rot (true, MNode (kk, vv, bf, l, rr))]
+			            else [false, rot (true, MNode (kk, vv, bf, l, rot (false, rr)))]
+			            fi				   
+			       else [true,  MNode (kk, vv, bf - 1, l, rr)] 
+			       fi
+              | [false, rr] -> [false, MNode (kk, vv, bf, l, rr)]
+	      esac
+            fi
+       fi	
+    esac
+  }
+
+  (m.inner (k, v)).snd
+} 
+
+public fun find (m, k) {
+  case m of
+    {} -> None
+  | MNode (kk, vv, _, l, r) ->
+     local c = compare (k, kk);
+     if c == 0
+     then case vv of v : _ -> Some (v) | _ -> None esac
+     else find (if c < 0 then l else r fi, k)
+     fi
+  esac
+}
+
+public fun remove (m, k) {
+  case m of
+    {} -> m
+  | MNode (kk, vv, bf, l, r) ->
+     local c = compare (k, kk);
+     if c == 0
+     then case vv of {} -> m | _ : vt -> MNode (kk, vt, l, r) esac
+     else if c < 0
+          then MNode (kk, vv, bf, remove (l, k), r)
+          else MNode (kk, vv, bf, l, remove (r, k))
+          fi
+     fi
+  esac
+}
+
+fun validate (t) {
+  fun inner (t, verify) {
+    case t of
+      {} -> 0
+    | MNode (k, _, bf, l, r) ->
+       if verify (k)
+       then
+	 local lh = validate (l, fun (x) {(*return*) x < k}),
+	       rh = validate (r, fun (x) {(*return*) x > k});
+
+         if bf == lh - rh
+	 then 1 + if lh > rh then lh else rh fi
+	 else failure ("Balance violation on key %s\n", k.string)
+	 fi
+       else failure ("Order violation on key %s\n", k.string)
+       fi
+    esac
+  }
+
+  inner (t, fun (x) {true})
+}
+

stdlib/Matcher.expr

@@ -8,7 +8,7 @@
 --             (e.g. "identifier", "string constant", etc.), used for error
 --             reporting
 fun createRegexp (r, name) {
-  return [regexp (r), name]
+  [regexp (r), name]
 }
 
 -- Create an immutable matcher.
@@ -21,12 +21,12 @@ fun createRegexp (r, name) {
 fun matcherCreate (buf, pos, line, col) {
   -- Shows a matcher in a readable form
   fun show () {
-    return sprintf ("buf : %-40s\npos : %d\nline: %d\ncol : %d\n", buf, pos, line, col)
+    sprintf ("buf : %-40s\npos : %d\nline: %d\ncol : %d\n", buf, pos, line, col)
   }
 
   -- Calculates the number of remaining unmatched characters in the buffer
   fun rest () {
-    return buf.length - pos
+    buf.length - pos
   }
 
   -- Moves the position pointer on given number of characters.
@@ -41,11 +41,10 @@ fun matcherCreate (buf, pos, line, col) {
       esac
     od;
     
-    return matcherCreate (buf, pos + n, l, c)
+    matcherCreate (buf, pos + n, l, c)
   }
 
   fun matchString (s) {
-    return
     if s.length > rest ()
     then Fail (sprintf ("""%s"" expected at %d:%d", s, line, col))
     elif matchSubString (buf, s, pos) then Succ (shift (s.length), s) 
@@ -56,7 +55,6 @@ fun matcherCreate (buf, pos, line, col) {
   fun matchRegexp (r) {
     local n;
     
-    return
     if (n := regexpMatch (r[0], buf, pos)) > 0
     then Succ (shift (n), substring (buf, pos, n))
     else Fail (sprintf ("%s expected at %d:%d", r[1], line, col))
@@ -64,11 +62,10 @@ fun matcherCreate (buf, pos, line, col) {
   }
 
   fun eof () {
-    return rest () == 0
+    rest () == 0
   }
   
-  return [
+  [show,
-     show,
    eof,
    matchString,
    matchRegexp
@@ -76,31 +73,27 @@ fun matcherCreate (buf, pos, line, col) {
 }
 
 fun show (m) {
-  return m [0] ()
+  m [0] ()
 }
 
 fun endOf (m) {
-  return m [1] ()
+  m [1] ()
 }
 
 fun matchString (m, s) {
-  return m [2] (s)
+  m [2] (s)
 }
 
 -- Matches against a regexp
 fun matchRegexp (m, r) {
-  return m [3] (r)
+  m [3] (r)
 }
 
 -- Creates a fresh matcher from a string buffer
 public fun matcherInit (buf) {
-  return matcherCreate (buf, 0, 1, 1)
+  matcherCreate (buf, 0, 1, 1)
 }
 
---fun parse (a) {
- 
---}
-
 local m = matcherInit ("   -- asdasdakm ,m.,msd .,m.,asd\n    \n\n abc");
 
 local
@@ -112,24 +105,24 @@ local
   chr     = createRegexp ("'[^']'", "character literal");
 
 fun token (s) {
-  return fun (m) {return m.matchString (s)}
+  fun (m) {m.matchString (s)}
 }
 
+
 fun lid (m) {
-  return m.matchRegexp (lident)
+  matchRegexp (m, lident)
 }
 
 fun uid (m) {
-  return m.matchRegexp (uident)
+  matchRegexp (m, uident)
 }
 
 fun const (m) {
-  return m.matchRegexp (decimal)
+  matchRegexp (m, decimal)
 }
 
 infixl "@" before "*" (p, f) {
-  return fun (m) {
+  fun (m) {    
-    return
     case p (m) of
       Succ (m, x) -> Succ (m, f (x))
     | err         -> err
@@ -138,8 +131,7 @@ infixl "@" before "*" (p, f) {
 }
 
 infixr "|>" after "!!" (l, r) {
-  return fun (m) {
+  fun (m) {
-    return 
     case l (m) of
       Succ (m, s) -> r (s) (m)
     | err         -> err
@@ -148,8 +140,7 @@ infixr "|>" after "!!" (l, r) {
 }
 
 infixr "||" after "|>" (l, r) {
-  return fun (m) {
+  fun (m) {  
-    return 
     case l (m) of
       s@Succ (_, _) -> s 
     | err           -> r (m)
@@ -157,20 +148,7 @@ infixr "||" after "|>" (l, r) {
   }
 }
 
-local expr = lid   @ fun (s) {return Lid (s)} ||
+local expr = lid @ fun (s) {Lid (s)} || const @ fun (s) {Dec (s)},
-             const @ fun (s) {return Dec (s)},
+      assn = lid |> fun (id) {token (":=") |> fun (s) {expr @ fun (e) {Assn (id, e)}}};
-      assn = lid |> fun (id) {return token (":=") |> fun (s) {return expr @ fun (e) {return Assn (id, e)}}};
-
-printf ("%s\n", assn (matcherInit ("x:=3")).string)
-
---local ident       = createRegexp ("[a-z][a-zA-Z_]*", "identifier");
---local ws          = createRegexp ("[ \n\t]+", "whitespace");
-
---local ws          = createRegexp ("\\([ \t\n]\\|--[^\n]*\n\\)*", "whitespace");
-
---local str         = createRegexp ("""\([^""]\|""""\)*""", "string literal");
---local lineComment = createRegexp ("--[^\n]*\n", "line comment");
-
---printf ("ws: %s\n", case m.matchRegexp (ws) of Succ (m, s) -> "(" ++ m.show  ++ ", " ++ s ++ ")" | Fail (err) -> err.string esac);
-
 
+printf ("%s\n", case assn (matcherInit ("x:=3")) of Fail (err) -> err | Succ (_, s) -> s.string esac)

stdlib/test01.expr

@@ -0,0 +1,23 @@
+import Collection;
+
+local tree = {}, i;
+
+for i := 100, i >= 1, i := i-1 do
+  tree := insert (tree, i, i);
+  printf ("Inserting: %s\n", i.string);
+  printf ("Result   : %s\n", tree.string)
+od;
+
+tree := {};
+
+for i := 1, i <= 100, i := i+2 do
+  tree := insert (tree, i, i);
+  printf ("Inserting: %s\n", i.string);
+  printf ("Result   : %s\n", tree.string)
+od;
+
+for i := 2, i <= 100, i := i+2 do
+  tree := insert (tree, i, i);
+  printf ("Inserting: %s\n", i.string);
+  printf ("Result   : %s\n", tree.string)
+od