~jojo/Carth

96ca517fd7ed61e80ca50c8439a175d2f9c2879f — JoJo 1 year, 5 months ago 19d2035
Rename start to main by mapping "main" to "_main" in mangleName

I tried having the carth-level entrypoint be called "main" before, but
it didn't work out since I tried having it compile to "main", and then
add a wrapping main that compiled to something like "outer_main", and
then redefine the entrypoint to "outer_main" when calling clang. That
was messy due to startfiles-related issues, but this way of simply
mapping "main" to "_main" via mangleName seems to work really well!
M examples/fizzbuzz.carth => examples/fizzbuzz.carth +1 -1
@@ 1,6 1,6 @@
(import std)

(define (start _) (fizzbuzz unit))
(define (main _) (fizzbuzz unit))

(define (fizzbuzz _)
  (for (range 1 100)

M examples/hello-world.carth => examples/hello-world.carth +1 -1
@@ 1,4 1,4 @@
(import std)

(define (start _)
(define (main _)
  (display (str-append "Hello, world!" "\n")))

M examples/literate.org => examples/literate.org +1 -1
@@ 12,7 12,7 @@ First we import the standard library.
explicitly won't hurt.

#+BEGIN_SRC carth :tangle yes
(define (start _)
(define (main _)
  (display (id "Literate programming rules!")))
#+END_SRC


M src/Check.hs => src/Check.hs +3 -3
@@ 36,12 36,12 @@ typecheck (Parsed.Program defs tdefs externs) = runExcept $ do
    checkTypeVarsBound substd
    let mTypeDefs = fmap (map (unpos . fst) . snd) tdefs'
    compiled <- compileDecisionTrees mTypeDefs substd
    checkStartDefined compiled
    checkMainDefined compiled
    let tdefs'' = fmap (second (map snd)) tdefs'
    pure (Checked.Program compiled tdefs'' externs')
  where
    checkStartDefined (Topo ds) =
        when (not (elem "start" (map fst ds))) (throwError StartNotDefined)
    checkMainDefined (Topo ds) =
        when (not (elem "main" (map fst ds))) (throwError MainNotDefined)

type CheckTypeDefs a
    = ReaderT

M src/Checked.hs => src/Checked.hs +2 -2
@@ 20,7 20,7 @@ module Checked
    , TypeDefs
    , Externs
    , Program(..)
    , startType
    , mainType
    )
where



@@ 39,7 39,7 @@ import Inferred
    , VariantIx
    , Span
    , Con(..)
    , startType
    , mainType
    )

data TypedVar = TypedVar String Type

M src/Codegen.hs => src/Codegen.hs +8 -2
@@ 220,7 220,7 @@ genMain = do
    assign currentBlockLabel (mkName "entry")
    assign currentBlockInstrs []
    Out basicBlocks _ _ _ <- execWriterT $ do
        f <- lookupVar (TypedVar "start" startType)
        f <- lookupVar (TypedVar "main" mainType)
        _ <- app f (VLocal litUnit) typeUnit
        commitFinalFuncBlock (ret (litI32 0))
    pure (GlobalDefinition (simpleFunc (mkName "main") [] i32 basicBlocks []))


@@ 1009,7 1009,13 @@ getIntBitWidth = \case
    t -> ice $ "Tried to get bit width of non-integer type " ++ show t

mangleName :: (String, [Monomorphic.Type]) -> String
mangleName (x, us) = x ++ mangleInst us
mangleName = \case
    -- Instead of dealing with changing entrypoint name and startfiles, just
    -- call the outermost, compiler generated main `main`, and the user-defined
    -- main `_main`, via this `mangleName` mechanic.
    ("main", []) -> "_main"
    ("main", _) -> ice "mangleName of `main` of non-empty instantiation"
    (x, us) -> x ++ mangleInst us

mangleInst :: [Monomorphic.Type] -> String
mangleInst ts = if not (null ts)

M src/Infer.hs => src/Infer.hs +4 -4
@@ 178,10 178,10 @@ inferDefsComponents = \case
-- | Verify that user-provided type signature schemes are valid
checkScheme :: (String, Maybe Parsed.Scheme) -> Infer (Maybe Scheme)
checkScheme = \case
    ("start", Nothing) -> pure (Just (Forall Set.empty startType))
    ("start", Just s@(Parsed.Forall pos vs t))
        | Set.size vs /= 0 || t /= Parsed.startType -> throwError
            (WrongStartType pos s)
    ("main", Nothing) -> pure (Just (Forall Set.empty mainType))
    ("main", Just s@(Parsed.Forall pos vs t))
        | Set.size vs /= 0 || t /= Parsed.mainType -> throwError
            (WrongMainType pos s)
    (_, Nothing) -> pure Nothing
    (_, Just (Parsed.Forall pos vs t)) -> do
        t' <- checkType pos t

M src/Inferred.hs => src/Inferred.hs +3 -3
@@ 26,7 26,7 @@ module Inferred
    , TypeDefs
    , Ctors
    , Externs
    , startType
    , mainType
    )
where



@@ 111,5 111,5 @@ instance Ord Con where
    compare (Con c1 _ _) (Con c2 _ _) = compare c1 c2


startType :: Type
startType = TFun (TPrim TUnit) (TPrim TUnit)
mainType :: Type
mainType = TFun (TPrim TUnit) (TPrim TUnit)

M src/Monomorphic.hs => src/Monomorphic.hs +3 -3
@@ 21,7 21,7 @@ module Monomorphic
    , Defs
    , TypeDefs
    , Program(..)
    , startType
    , mainType
    )
where



@@ 121,5 121,5 @@ fvDecisionTree = \case
    fvDSwitch es def =
        Set.unions $ fvDecisionTree def : map fvDecisionTree es

startType :: Type
startType = TFun (TPrim TUnit) (TPrim TUnit)
mainType :: Type
mainType = TFun (TPrim TUnit) (TPrim TUnit)

M src/Monomorphize.hs => src/Monomorphize.hs +1 -1
@@ 44,7 44,7 @@ monomorphize (Checked.Program defs tdefs externs) = evalMono $ do
    externs' <- mapM (bimapM pure monotype) (Map.toList externs)
    (defs', _) <- monoLet
        defs
        (noPos (Checked.Var (Checked.TypedVar "start" Checked.startType)))
        (noPos (Checked.Var (Checked.TypedVar "main" Checked.mainType)))
    tdefs' <- instTypeDefs tdefs
    pure (Program defs' tdefs' externs')


M src/Parsed.hs => src/Parsed.hs +3 -3
@@ 20,7 20,7 @@ module Parsed
    , Extern(..)
    , Program(..)
    , isFunLike
    , startType
    , mainType
    )
where



@@ 182,8 182,8 @@ bvPat = \case
idstr :: Id a -> String
idstr (Id (WithPos _ x)) = x

startType :: Type
startType = TFun (TPrim TUnit) (TPrim TUnit)
mainType :: Type
mainType = TFun (TPrim TUnit) (TPrim TUnit)

isFunLike :: Expr -> Bool
isFunLike (WithPos _ e) = case e of

M src/TypeErr.hs => src/TypeErr.hs +6 -6
@@ 13,7 13,7 @@ import Parse


data TypeErr
    = StartNotDefined
    = MainNotDefined
    | InvalidUserTypeSig SrcPos Scheme Scheme
    | CtorArityMismatch SrcPos String Int Int
    | ConflictingPatVarDefs SrcPos String


@@ 30,7 30,7 @@ data TypeErr
    | RecTypeDef String SrcPos
    | UndefType SrcPos String
    | UnboundTVar SrcPos
    | WrongStartType SrcPos Parsed.Scheme
    | WrongMainType SrcPos Parsed.Scheme
    | RecursiveVarDef (WithPos String)
    | TypeInstArityMismatch SrcPos String Int Int
    | ConflictingVarDef SrcPos String


@@ 40,7 40,7 @@ type Message = String

printErr :: TypeErr -> IO ()
printErr = \case
    StartNotDefined -> putStrLn "Error: start not defined"
    MainNotDefined -> putStrLn "Error: main not defined"
    InvalidUserTypeSig p s1 s2 ->
        posd p
            $ ("Invalid user type signature " ++ pretty s1)


@@ 92,10 92,10 @@ printErr = \case
        posd p
            $ "Could not fully infer type of expression.\n"
            ++ "Type annotations needed."
    WrongStartType p s ->
    WrongMainType p s ->
        posd p
            $ "Incorrect type of `start`.\n"
            ++ ("Expected: " ++ pretty startType)
            $ "Incorrect type of `main`.\n"
            ++ ("Expected: " ++ pretty mainType)
            ++ ("\nFound: " ++ pretty s)
    RecursiveVarDef (WithPos p x) ->
        posd p