diff options
| -rw-r--r-- | lib/ur/basis.urs | 1 | ||||
| -rw-r--r-- | lib/ur/option.ur | 5 | ||||
| -rw-r--r-- | lib/ur/option.urs | 1 | ||||
| -rw-r--r-- | src/monoize.sml | 26 |
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) => |