diff --git a/src/back/CodeGen/ClassDecl.hs b/src/back/CodeGen/ClassDecl.hs index d6c89c9b2..d5d4b7d61 100644 --- a/src/back/CodeGen/ClassDecl.hs +++ b/src/back/CodeGen/ClassDecl.hs @@ -69,7 +69,8 @@ translateActiveClass cdecl@(A.Class{A.cname, A.fields, A.methods}) ctable = ( task_dispatch_clause : (if (A.isMainClass cdecl) - then pony_main_clause : (method_clauses $ filter ((/= ID.Name "main") . A.mname) methods) + then pony_main_clause : + (method_clauses $ filter ((/= ID.Name "main") . A.mname) methods) else method_clauses $ methods )) (Statement $ Call (Nam "printf") [String "error, got invalid id: %zd", AsExpr $ (Var "_m") `Arrow` (Nam "id")]))])) @@ -79,8 +80,10 @@ translateActiveClass cdecl@(A.Class{A.cname, A.fields, A.methods}) ctable = Seq $ [Assign (Decl (Ptr $ Typ "pony_main_msg_t", Var "msg")) (Cast (Ptr $ Typ "pony_main_msg_t") (Var "_m")), Statement $ Call ((method_impl_name (Ty.refType "Main") (ID.Name "main"))) [(Cast (Ptr $ Typ "_enc__active_Main_t") (Var "_a")), - AsExpr $ (Var "msg") `Arrow` (Nam "argc"), - AsExpr $ (Var "msg") `Arrow` (Nam "argv")]]) + Call (Nam "array_from_array") + [AsExpr $ (Var "msg") `Arrow` (Nam "argc"), + AsExpr $ Var "ENCORE_PRIMITIVE", + Cast (Ptr encore_arg_t) $ (Var "msg") `Arrow` (Nam "argv")]]]) method_clauses = concatMap method_clause diff --git a/src/back/CodeGen/Header.hs b/src/back/CodeGen/Header.hs index e44a7b02c..36e01d2ef 100644 --- a/src/back/CodeGen/Header.hs +++ b/src/back/CodeGen/Header.hs @@ -203,7 +203,7 @@ generate_header p = where method_fwd A.Method{A.mtype, A.mname, A.mparams} = let params = if (A.isMainClass cdecl) && (mname == ID.Name "main") - then [Ptr . AsType $ class_type_name cname, int, Ptr $ Ptr char] + then [Ptr . AsType $ class_type_name cname, array] else (Ptr . AsType $ class_type_name cname) : map (\(A.Param {A.ptype}) -> (translate ptype)) mparams in FunctionDecl (translate mtype) (method_impl_name cname mname) params diff --git a/src/back/CodeGen/MethodDecl.hs b/src/back/CodeGen/MethodDecl.hs index 10edae46d..09a75fdbb 100644 --- a/src/back/CodeGen/MethodDecl.hs +++ b/src/back/CodeGen/MethodDecl.hs @@ -25,41 +25,53 @@ instance Translatable A.MethodDecl (A.ClassDecl -> ClassTable -> CCode Toplevel) translate mdecl@(A.Method {A.mtype, A.mname, A.mparams, A.mbody}) cdecl@(A.Class {A.cname}) ctable = - let enc_arg_names = map A.pname mparams + let return_type = translate mtype + name = (method_impl_name cname mname) + enc_arg_names = map A.pname mparams enc_arg_types = map A.ptype mparams arg_names = map arg_name enc_arg_names arg_types = map translate enc_arg_types - ctx = Ctx.new ((ID.Name "this", Var "_this") : (zip enc_arg_names arg_names)) ctable + args = (Ptr . AsType $ class_type_name cname, Var "_this") : + if A.isMainClass cdecl && mname == ID.Name "main" + then if null arg_names + then [(array, Var "_argv")] + else zip arg_types arg_names + else zip arg_types arg_names + ctx = Ctx.new ((ID.Name "this", Var "_this") : + (zip enc_arg_names arg_names)) ctable ((bodyn,bodys),_) = runState (translate mbody) ctx - -- This reverse makes nested closures come before their enclosing closures. Not very nice... - closures = map (\clos -> translateClosure clos ctable) (reverse (Util.filter A.isClosure mbody)) - tasks = map (\tas -> translateTask tas ctable) $ reverse $ Util.filter A.isTask mbody + -- This reverse makes nested closures come before their + -- enclosing closures. Not very nice... + closures = map (\clos -> translateClosure clos ctable) + (reverse (Util.filter A.isClosure mbody)) + tasks = map (\tas -> translateTask tas ctable) $ + reverse $ Util.filter A.isTask mbody ret_stmt = Return $ if Ty.isVoidType mtype then unit else bodyn in Concat $ closures ++ tasks ++ - [Function (translate mtype) (method_impl_name cname mname) - -- When we have a top-level main function, this should be cleaned up - (if (A.isMainClass cdecl) && (mname == ID.Name "main") - then [(Ptr . AsType $ class_type_name cname, Var "_this"), (int, Var "argc"), (Ptr $ Ptr char, Var "argv")] - else (Ptr . AsType $ class_type_name cname, Var "_this") : (zip arg_types arg_names)) - (Seq $ [bodys, ret_stmt]) - ] + [Function return_type name args (Seq $ [bodys, ret_stmt])] translate mdecl@(A.StreamMethod {A.mtype, A.mname, A.mparams, A.mbody}) cdecl@(A.Class {A.cname}) ctable = - let enc_arg_names = map A.pname mparams + let name = (method_impl_name cname mname) + enc_arg_names = map A.pname mparams enc_arg_types = map A.ptype mparams arg_names = map arg_name enc_arg_names arg_types = map translate enc_arg_types - ctx = Ctx.new ((ID.Name "this", Var "_this") : (zip enc_arg_names arg_names)) ctable + args = (Ptr . AsType $ class_type_name cname, Var "_this") : + (stream, stream_handle) : + zip arg_types arg_names + ctx = Ctx.new ((ID.Name "this", Var "_this") : + (zip enc_arg_names arg_names)) ctable ((bodyn,bodys),_) = runState (translate mbody) ctx - -- This reverse makes nested closures come before their enclosing closures. Not very nice... - closures = map (\clos -> translateClosure clos ctable) (reverse (Util.filter A.isClosure mbody)) - tasks = map (\tas -> translateTask tas ctable) $ reverse $ Util.filter A.isTask mbody + -- This reverse makes nested closures come before their + -- enclosing closures. Not very nice... + closures = map (\clos -> translateClosure clos ctable) + (reverse (Util.filter A.isClosure mbody)) + tasks = map (\tas -> translateTask tas ctable) $ + reverse $ Util.filter A.isTask mbody + stream_close = Statement $ Call (Nam "stream_close") [stream_handle] in Concat $ closures ++ tasks ++ - [Function void (method_impl_name cname mname) - ((Ptr . AsType $ class_type_name cname, Var "_this") : (stream, stream_handle) : - (zip arg_types arg_names)) - (Seq $ bodys : [Statement $ Call (Nam "stream_close") [stream_handle]])] + [Function void name args (Seq $ [bodys, stream_close])] diff --git a/src/runtime/array/array.c b/src/runtime/array/array.c index deeb101db..e01985407 100644 --- a/src/runtime/array/array.c +++ b/src/runtime/array/array.c @@ -44,6 +44,15 @@ array_t *array_mk(size_t size, pony_type_t *type) return array; } +array_t *array_from_array(size_t size, pony_type_t *type, encore_arg_t arr[]) +{ + struct array_t *array = array_mk(size, type); + for(int i = 0; i < size; i++) { + array_set(array, i, arr[i]); + } + return array; +} + inline size_t array_size(array_t *a) { return ((struct array_t *)a)->size; diff --git a/src/runtime/array/array.h b/src/runtime/array/array.h index 7704a6ad1..b8d059e65 100644 --- a/src/runtime/array/array.h +++ b/src/runtime/array/array.h @@ -12,6 +12,8 @@ void array_trace(void *); array_t *array_mk(size_t size, pony_type_t *type); +array_t *array_from_array(size_t size, pony_type_t *type, encore_arg_t arr[]); + size_t array_size(array_t *a); encore_arg_t array_get(array_t *a, size_t i); diff --git a/src/types/Typechecker/Typechecker.hs b/src/types/Typechecker/Typechecker.hs index dc09d1c05..4e390fbe9 100644 --- a/src/types/Typechecker/Typechecker.hs +++ b/src/types/Typechecker/Typechecker.hs @@ -395,9 +395,9 @@ instance Checkable MethodDecl where else pushHasType mbody ty return $ setType ty m {mtype = ty, mbody = eBody, mparams = eMparams} where - checkMainParams = unless ((map ptype mparams) `elem` [[] {-, [intType, arrayType stringType]-}]) $ + checkMainParams = unless ((map ptype mparams) `elem` [[], [arrayType stringType]]) $ tcError $ - "Main method must have argument type () or (int, string[]) (but arrays are not supported yet)" + "Main method must have argument type () or ([string])" typecheckParam p@(Param{ptype}) = local (pushBT p) $ do ty <- checkType ptype return $ setType ty p