summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Austin Seipp <mad.one@gmail.com>2012-11-28 11:41:54 -0500
committerGravatar Austin Seipp <mad.one@gmail.com>2012-11-28 11:41:54 -0500
commit9157968f41a0cc24e6621e2860f50a98866ed541 (patch)
tree3fcdb678f49ee4d5a3c2c04364828fc97cfae1ff
parent3ef0f1fcb1df60f2d5944a9ff2902d0885fcb13f (diff)
Standard library additions: Option.unsafeGet, Basis.exp
-rw-r--r--lib/ur/basis.urs1
-rw-r--r--lib/ur/option.ur5
-rw-r--r--lib/ur/option.urs1
-rw-r--r--src/monoize.sml26
4 files changed, 27 insertions, 6 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 1bfd9da6..67564108 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -42,6 +42,7 @@ val minus : t ::: Type -> num t -> t -> t -> t
val times : t ::: Type -> num t -> t -> t -> t
val divide : t ::: Type -> num t -> t -> t -> t
val mod : t ::: Type -> num t -> t -> t -> t
+val exp : t ::: Type -> num t -> t -> t -> t
val num_int : num int
val num_float : num float
diff --git a/lib/ur/option.ur b/lib/ur/option.ur
index 5c89fc9d..05c50d1f 100644
--- a/lib/ur/option.ur
+++ b/lib/ur/option.ur
@@ -49,3 +49,8 @@ fun get [a] (x : a) (o : option a) =
case o of
None => x
| Some v => v
+
+fun unsafeGet [a] (o : option a) =
+ case o of
+ None => error <xml>Option.unsafeGet: encountered None</xml>
+ | Some v => v
diff --git a/lib/ur/option.urs b/lib/ur/option.urs
index ba43613f..126999a3 100644
--- a/lib/ur/option.urs
+++ b/lib/ur/option.urs
@@ -12,3 +12,4 @@ val mp : a ::: Type -> b ::: Type -> (a -> b) -> t a -> t b
val bind : a ::: Type -> b ::: Type -> (a -> option b) -> t a -> t b
val get : a ::: Type -> a -> option a -> a
+val unsafeGet : a ::: Type -> option a -> a
diff --git a/src/monoize.sml b/src/monoize.sml
index d25e4d1f..bee3fe97 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -191,7 +191,8 @@ fun monoType env =
("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
- ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))],
+ ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+ ("Exp", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))],
loc)
end
| L.CApp ((L.CFfi ("Basis", "ord"), _), t) =>
@@ -791,15 +792,17 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
- ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc)
- fun numEx (t, zero, neg, plus, minus, times, dv, md) =
+ ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+ ("Exp", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc)
+ fun numEx (t, zero, neg, plus, minus, times, dv, md, ex) =
((L'.ERecord [("Zero", (L'.EPrim zero, loc), t),
("Neg", neg, (L'.TFun (t, t), loc)),
("Plus", plus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
("Minus", minus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
("Times", times, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
("Div", dv, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
- ("Mod", md, (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc), fm)
+ ("Mod", md, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+ ("Exp", ex, (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc), fm)
fun ordTy t =
(L'.TRecord [("Lt", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)),
@@ -1029,6 +1032,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
(L'.EField ((L'.ERel 0, loc), "Mod"), loc)), loc), fm)
end
+ | L.ECApp ((L.EFfi ("Basis", "exp"), _), t) =>
+ let
+ val t = monoType env t
+ in
+ ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+ (L'.EField ((L'.ERel 0, loc), "Exp"), loc)), loc), fm)
+ end
| L.EFfi ("Basis", "num_int") =>
let
fun intBin s =
@@ -1047,7 +1057,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
intBin "-",
intBin "*",
intBin "/",
- intBin "%")
+ intBin "%",
+ intBin "powl"
+ )
end
| L.EFfi ("Basis", "num_float") =>
let
@@ -1067,7 +1079,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
floatBin "-",
floatBin "*",
floatBin "fdiv",
- floatBin "fmod")
+ floatBin "fmod",
+ floatBin "powf"
+ )
end
| L.ECApp ((L.EFfi ("Basis", "lt"), _), t) =>