fix the cons type

ElaraLang · Nov 7, 2023 · 8813151 · 8813151
1 parent b63f0f9
commit 8813151
Show file tree

Hide file tree

Showing 3 changed files with 5 additions and 4 deletions.
diff --git a/src/Elara/Core.hs b/src/Elara/Core.hs
@@ -86,6 +86,7 @@ data Type
 typeArity :: Type -> Int
 typeArity = \case
     FuncTy _ b -> 1 + typeArity b
+    ForAllTy _ t -> typeArity t
     _ -> 0
 
 instantiate :: Type -> Type -> Type

diff --git a/src/Elara/Emit/Expr.hs b/src/Elara/Emit/Expr.hs
@@ -18,7 +18,7 @@ import JVM.Data.Abstract.Type qualified as JVM
 import JVM.Data.Raw.Types
 import Polysemy
 import Polysemy.State
-import Print (showPretty)
+import Print (showPretty, debugPretty)
 
 generateInstructions :: (HasCallStack, Member (State MethodCreationState) r, Member (Embed CodeBuilder) r) => Expr JVMBinder -> Sem r ()
 generateInstructions (Var (JVMLocal 0)) = embed $ emit $ ALoad 0
@@ -91,15 +91,15 @@ generateAppInstructions :: (Member (State MethodCreationState) r, Member (Embed
 generateAppInstructions f x = do
     let (f', args) = collectArgs f [x]
     let (fName, fType) = approximateTypeAndNameOf f'
-
+    
     let arity = typeArity fType
     if length args == arity
         then -- yippee, no currying necessary
         do
             let insts = invokeStaticVars fName fType
             traverse_ generateInstructions args
             embed $ emit $ uncurry3 InvokeStatic insts
-        else error $ "Arity mismatch: " <> show arity <> " vs " <> show (length args) <> " for " <> showPretty f <> " " <> showPretty x <> " " <> showPretty f'
+        else error $ "Arity mismatch: " <> show arity <> " vs " <> show (length args) <> " for f=" <> showPretty f <> " x=" <> showPretty x <> ", f'=" <> showPretty f' <> ", args=" <> showPretty args
   where
     collectArgs :: JVMExpr -> [JVMExpr] -> (JVMExpr, [JVMExpr])
     collectArgs (App f x) args = collectArgs f (x : args)

diff --git a/src/Elara/Prim/Core.hs b/src/Elara/Prim/Core.hs
@@ -24,7 +24,7 @@ consType :: Member UniqueGen r => Sem r Type
 consType = do
     a <- makeUnique (Just "a")
     let tv = TypeVariable a TypeKind
-    pure $ ForAllTy tv (FuncTy (AppTy listCon (TyVarTy tv)) ((AppTy listCon (TyVarTy tv))))
+    pure $ ForAllTy tv (FuncTy (TyVarTy tv) (FuncTy (AppTy listCon (TyVarTy tv)) ((AppTy listCon (TyVarTy tv)))))
 
 tuple2CtorName :: Qualified Text
 tuple2CtorName = Qualified "Tuple2" (ModuleName ("Elara" :| ["Prim"]))