mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-06 06:48:48 +00:00
Removed unneeded returns from stdlib (yu-yu\!)
This commit is contained in:
parent
274bda6938
commit
290c124be6
3 changed files with 179 additions and 68 deletions
110
stdlib/Collection.expr
Normal file
110
stdlib/Collection.expr
Normal file
|
|
@ -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})
|
||||||
|
}
|
||||||
|
|
||||||
|
|
@ -8,7 +8,7 @@
|
||||||
-- (e.g. "identifier", "string constant", etc.), used for error
|
-- (e.g. "identifier", "string constant", etc.), used for error
|
||||||
-- reporting
|
-- reporting
|
||||||
fun createRegexp (r, name) {
|
fun createRegexp (r, name) {
|
||||||
return [regexp (r), name]
|
[regexp (r), name]
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Create an immutable matcher.
|
-- Create an immutable matcher.
|
||||||
|
|
@ -21,12 +21,12 @@ fun createRegexp (r, name) {
|
||||||
fun matcherCreate (buf, pos, line, col) {
|
fun matcherCreate (buf, pos, line, col) {
|
||||||
-- Shows a matcher in a readable form
|
-- Shows a matcher in a readable form
|
||||||
fun show () {
|
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
|
-- Calculates the number of remaining unmatched characters in the buffer
|
||||||
fun rest () {
|
fun rest () {
|
||||||
return buf.length - pos
|
buf.length - pos
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Moves the position pointer on given number of characters.
|
-- Moves the position pointer on given number of characters.
|
||||||
|
|
@ -41,66 +41,59 @@ fun matcherCreate (buf, pos, line, col) {
|
||||||
esac
|
esac
|
||||||
od;
|
od;
|
||||||
|
|
||||||
return matcherCreate (buf, pos + n, l, c)
|
matcherCreate (buf, pos + n, l, c)
|
||||||
}
|
}
|
||||||
|
|
||||||
fun matchString (s) {
|
fun matchString (s) {
|
||||||
return
|
if s.length > rest ()
|
||||||
if s.length > rest ()
|
then Fail (sprintf ("""%s"" expected at %d:%d", s, line, col))
|
||||||
then Fail (sprintf ("""%s"" expected at %d:%d", s, line, col))
|
elif matchSubString (buf, s, pos) then Succ (shift (s.length), s)
|
||||||
elif matchSubString (buf, s, pos) then Succ (shift (s.length), s)
|
else Fail (sprintf ("""%s"" expected at %d:%d", s, line, col))
|
||||||
else Fail (sprintf ("""%s"" expected at %d:%d", s, line, col))
|
fi
|
||||||
fi
|
|
||||||
}
|
}
|
||||||
|
|
||||||
fun matchRegexp (r) {
|
fun matchRegexp (r) {
|
||||||
local n;
|
local n;
|
||||||
|
|
||||||
return
|
if (n := regexpMatch (r[0], buf, pos)) > 0
|
||||||
if (n := regexpMatch (r[0], buf, pos)) > 0
|
then Succ (shift (n), substring (buf, pos, n))
|
||||||
then Succ (shift (n), substring (buf, pos, n))
|
else Fail (sprintf ("%s expected at %d:%d", r[1], line, col))
|
||||||
else Fail (sprintf ("%s expected at %d:%d", r[1], line, col))
|
fi
|
||||||
fi
|
|
||||||
}
|
}
|
||||||
|
|
||||||
fun eof () {
|
fun eof () {
|
||||||
return rest () == 0
|
rest () == 0
|
||||||
}
|
}
|
||||||
|
|
||||||
return [
|
[show,
|
||||||
show,
|
eof,
|
||||||
eof,
|
matchString,
|
||||||
matchString,
|
matchRegexp
|
||||||
matchRegexp
|
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|
||||||
fun show (m) {
|
fun show (m) {
|
||||||
return m [0] ()
|
m [0] ()
|
||||||
}
|
}
|
||||||
|
|
||||||
fun endOf (m) {
|
fun endOf (m) {
|
||||||
return m [1] ()
|
m [1] ()
|
||||||
}
|
}
|
||||||
|
|
||||||
fun matchString (m, s) {
|
fun matchString (m, s) {
|
||||||
return m [2] (s)
|
m [2] (s)
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Matches against a regexp
|
-- Matches against a regexp
|
||||||
fun matchRegexp (m, r) {
|
fun matchRegexp (m, r) {
|
||||||
return m [3] (r)
|
m [3] (r)
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Creates a fresh matcher from a string buffer
|
-- Creates a fresh matcher from a string buffer
|
||||||
public fun matcherInit (buf) {
|
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 m = matcherInit (" -- asdasdakm ,m.,msd .,m.,asd\n \n\n abc");
|
||||||
|
|
||||||
local
|
local
|
||||||
|
|
@ -112,65 +105,50 @@ local
|
||||||
chr = createRegexp ("'[^']'", "character literal");
|
chr = createRegexp ("'[^']'", "character literal");
|
||||||
|
|
||||||
fun token (s) {
|
fun token (s) {
|
||||||
return fun (m) {return m.matchString (s)}
|
fun (m) {m.matchString (s)}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
fun lid (m) {
|
fun lid (m) {
|
||||||
return m.matchRegexp (lident)
|
matchRegexp (m, lident)
|
||||||
}
|
}
|
||||||
|
|
||||||
fun uid (m) {
|
fun uid (m) {
|
||||||
return m.matchRegexp (uident)
|
matchRegexp (m, uident)
|
||||||
}
|
}
|
||||||
|
|
||||||
fun const (m) {
|
fun const (m) {
|
||||||
return m.matchRegexp (decimal)
|
matchRegexp (m, decimal)
|
||||||
}
|
}
|
||||||
|
|
||||||
infixl "@" before "*" (p, f) {
|
infixl "@" before "*" (p, f) {
|
||||||
return fun (m) {
|
fun (m) {
|
||||||
return
|
case p (m) of
|
||||||
case p (m) of
|
Succ (m, x) -> Succ (m, f (x))
|
||||||
Succ (m, x) -> Succ (m, f (x))
|
| err -> err
|
||||||
| err -> err
|
esac
|
||||||
esac
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
infixr "|>" after "!!" (l, r) {
|
infixr "|>" after "!!" (l, r) {
|
||||||
return fun (m) {
|
fun (m) {
|
||||||
return
|
case l (m) of
|
||||||
case l (m) of
|
Succ (m, s) -> r (s) (m)
|
||||||
Succ (m, s) -> r (s) (m)
|
| err -> err
|
||||||
| err -> err
|
esac
|
||||||
esac
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
infixr "||" after "|>" (l, r) {
|
infixr "||" after "|>" (l, r) {
|
||||||
return fun (m) {
|
fun (m) {
|
||||||
return
|
case l (m) of
|
||||||
case l (m) of
|
s@Succ (_, _) -> s
|
||||||
s@Succ (_, _) -> s
|
| err -> r (m)
|
||||||
| err -> r (m)
|
esac
|
||||||
esac
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
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)
|
||||||
|
|
|
||||||
23
stdlib/test01.expr
Normal file
23
stdlib/test01.expr
Normal file
|
|
@ -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
|
||||||
Loading…
Add table
Add a link
Reference in a new issue