changeset 452:222cbc1da232

Fix some type-class detection
author Adam Chlipala <adamc@hcoop.net>
date Sat, 01 Nov 2008 17:19:12 -0400
parents 1bd575eb2d1e
children 787d4931fb07
files lib/basis.urs src/elab_env.sml src/elaborate.sml src/monoize.sml
diffstat 4 files changed, 12 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/lib/basis.urs	Sat Nov 01 16:50:28 2008 -0400
+++ b/lib/basis.urs	Sat Nov 01 17:19:12 2008 -0400
@@ -56,6 +56,7 @@
 val show_string : show string
 val show_bool : show bool
 val show_time : show time
+val mkShow : t ::: Type -> (t -> string) -> show t
 
 class read
 val read : t ::: Type -> read t -> string -> option t
--- a/src/elab_env.sml	Sat Nov 01 16:50:28 2008 -0400
+++ b/src/elab_env.sml	Sat Nov 01 17:19:12 2008 -0400
@@ -419,6 +419,7 @@
         (case (class_name_in f, class_key_in x) of
              (SOME f, SOME x) => SOME (f, x)
            | _ => NONE)
+      | CUnif (_, _, _, ref (SOME c)) => class_pair_in c
       | _ => NONE
 
 fun resolveClass (env : env) c =
--- a/src/elaborate.sml	Sat Nov 01 16:50:28 2008 -0400
+++ b/src/elaborate.sml	Sat Nov 01 17:19:12 2008 -0400
@@ -1398,6 +1398,7 @@
         in
             ((L'.CApp (f, x), loc), gs)
         end
+      | L'.CUnif (_, _, _, ref (SOME c)) => normClassConstraint envs c
       | _ => ((c, loc), [])
 
 
--- a/src/monoize.sml	Sat Nov 01 16:50:28 2008 -0400
+++ b/src/monoize.sml	Sat Nov 01 17:19:12 2008 -0400
@@ -844,6 +844,15 @@
             ((L'.EFfi ("Basis", "boolToString"), loc), fm)
           | L.EFfi ("Basis", "show_time") =>
             ((L'.EFfi ("Basis", "timeToString"), loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "mkShow"), _), t) =>
+            let
+                val t = monoType env t
+                val b = (L'.TFfi ("Basis", "string"), loc)
+                val dom = (L'.TFun (t, b), loc)
+            in
+                ((L'.EAbs ("f", dom, dom,
+                           (L'.ERel 0, loc)), loc), fm)
+            end
 
           | L.ECApp ((L.EFfi ("Basis", "read"), _), t) =>
             let