Merge pull request #1617 from actonlang/fix-method-opts-and-notimplem…

…ented-cgen Fix method opts and notimplemented cgen
actonlang · Jan 8, 2024 · 7f70aab · 7f70aab
2 parents c01ec04 + a35fcc4
commit 7f70aab
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 5 deletions.
diff --git a/compiler/Acton/CodeGen.hs b/compiler/Acton/CodeGen.hs
@@ -296,11 +296,15 @@ declModule env (s : ss)             = vcat [ gen env t <+> genTopName env n <> s
 
 
 declDecl env (Def _ n q p KwdNIL (Just t) b d fx)
-  | hasNotImpl b                    = gen env t <+> genTopName env n <+> parens (gen env p) <> semi
-  | otherwise                       = (gen env t1 <+> genTopName env n <+> parens (gen env p) <+> char '{') $+$
+  | hasNotImpl b                    = gen env t <+> genTopName env n <+> parens (gen env p) <> semi $+$
+                                      text "/*" $+$
+                                      decl $+$
+                                      text "*/"
+  | otherwise                       = decl
+  where decl                        = (gen env t1 <+> genTopName env n <+> parens (gen env p) <+> char '{') $+$
                                       nest 4 (genSuite env1 b) $+$
                                       char '}'
-  where env1                        = setRet t1 $ ldefine (envOf p) $ defineTVars q env
+        env1                        = setRet t1 $ ldefine (envOf p) $ defineTVars q env
         t1                          = exposeMsg fx t
 
 declDecl env (Class _ n q as b)
@@ -487,6 +491,7 @@ genStmt env s                       = vcat [ gen env t <+> gen env n <> semi | (
         env1                        = ldefine te env
 
 instance Gen Stmt where
+    gen env s | isNotImpl s         = text "//" <+> text "NotImplemented"
     gen env (Expr _ Strings{})      = semi
     gen env (Expr _ e)              = genExp' env e <> semi
     gen env (Assign _ [p] e)        = gen env p <+> equals <+> genExp env t e <> semi

diff --git a/compiler/Acton/Solver.hs b/compiler/Acton/Solver.hs
@@ -234,7 +234,7 @@ rank env (Cast _ t1@(TVar _ v1) t2@(TVar _ v2))
 rank env (Cast _ t1@TVar{} (TOpt _ t2@TVar{}))
   | univar (tvar t1), univar (tvar t2)      = RVar t1 [t2]
 rank env (Cast _ t1@TVar{} (TOpt _ t2))
-  | univar (tvar t1)                        = RTry t1 (allBelow env t2 ++ [tOpt tWild, tNone]) False
+  | univar (tvar t1)                        = RTry t1 ([tOpt tWild, tNone] ++ allBelow env t2) False
 rank env (Cast _ TNone{} t2@TVar{})
   | univar (tvar t2)                        = RTry t2 [tOpt tWild, tNone] True
 rank env (Cast _ t1@TVar{} t2)

diff --git a/compiler/Acton/Types.hs b/compiler/Acton/Types.hs
@@ -899,7 +899,9 @@ genEnv env cs te ds
                                                  ds1 = map (abstract q ds ws eq1) ds
                                              --traceM ("## genEnv defs 3 [" ++ prstrs gen_vs ++ "]\n" ++ render (nest 6 $ pretty te1))
                                              return (fix_cs, te1, eq2, ds1)
-  | otherwise                           = return (cs, te, [], ds)
+  | otherwise                           = do --traceM ("## genEnv local\n" ++ render (nest 6 $ pretty te))
+                                             --traceM ("## genEnv local cs:\n" ++ render (nest 4 $ vcat $ map pretty cs))
+                                             return (cs, te, [], ds)
   where
     qualify vs cs                       = let (q,wss) = unzip $ map qbind vs in (q, concat wss)
       where qbind v                     = (Quant v (casts ++ impls), wits)