~jojo/Carth

84c2ca2f84c9acd3ccef1a9b6d62068ba0435800 — JoJo 1 year, 5 months ago 96ca517
Add `unit` pattern literal
5 files changed, 13 insertions(+), 4 deletions(-)

M examples/hello-world.carth
M src/Infer.hs
M src/Parse.hs
M src/Parsed.hs
M src/Pretty.hs
M examples/hello-world.carth => examples/hello-world.carth +1 -1
@@ 1,4 1,4 @@
(import std)

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

M src/Infer.hs => src/Infer.hs +1 -0
@@ 271,6 271,7 @@ inferPat pat = fmap
    inferPat' = \case
        Parsed.PConstruction pos c ps -> inferPatConstruction pos c ps
        Parsed.PInt _ n -> pure (TPrim TInt, intToPCon n 64, Map.empty)
        Parsed.PUnit _ -> pure (TPrim TUnit, PWild, Map.empty)
        Parsed.PBool _ b ->
            pure (TPrim TBool, intToPCon (fromEnum b) 1, Map.empty)
        Parsed.PStr _ s ->

M src/Parse.hs => src/Parse.hs +7 -3
@@ 178,9 178,9 @@ def' schemeParser topPos = varDef <|> funDef
        pure (name, (WithPos topPos (scm, f)))

expr :: Parser Expr
expr = withPos $ choice [unit, estr, ebool, var, num, eConstructor, pexpr]
expr = withPos $ choice [eunit, estr, ebool, var, num, eConstructor, pexpr]
  where
    unit = reserved "unit" $> Lit Unit
    eunit = unit $> Lit Unit
    estr = fmap (Lit . Str) strlit
    ebool = fmap (Lit . Bool) bool
    eConstructor = fmap Ctor big'


@@ 227,6 227,9 @@ ns_num = do
            a
    pure (Lit e)

unit :: Parser ()
unit = reserved "unit" $> ()

bool :: Parser Bool
bool = (reserved "true" $> True) <|> (reserved "false" $> False)



@@ 237,10 240,11 @@ ns_strlit :: Parser String
ns_strlit = char '"' >> manyTill Lexer.charLiteral (char '"')

pat :: Parser Pat
pat = choice [patInt, patBool, patStr, patCtor, patVar, ppat]
pat = choice [patInt, patUnit, patBool, patStr, patCtor, patVar, ppat]
  where
    patInt = liftA2 PInt getSrcPos int
    int = andSkipSpaceAfter (Lexer.signed empty Lexer.decimal)
    patUnit = fmap PUnit getSrcPos <* unit
    patBool = liftA2 PBool getSrcPos bool
    patStr = liftA2 PStr getSrcPos strlit
    patCtor = fmap (\x -> PConstruction (getPos x) x []) big'

M src/Parsed.hs => src/Parsed.hs +3 -0
@@ 75,6 75,7 @@ data Scheme = Forall SrcPos (Set TVar) Type
data Pat
    = PConstruction SrcPos (Id 'Big) [Pat]
    | PInt SrcPos Int
    | PUnit SrcPos
    | PBool SrcPos Bool
    | PStr SrcPos String
    | PVar (Id 'Small)


@@ 140,6 141,7 @@ instance HasPos Pat where
    getPos = \case
        PConstruction p _ _ -> p
        PInt p _ -> p
        PUnit p -> p
        PBool p _ -> p
        PStr p _ -> p
        PVar v -> getPos v


@@ 174,6 176,7 @@ bvPat :: Pat -> Set (Id 'Small)
bvPat = \case
    PConstruction _ _ ps -> Set.unions (map bvPat ps)
    PInt _ _ -> Set.empty
    PUnit _ -> Set.empty
    PBool _ _ -> Set.empty
    PStr _ _ -> Set.empty
    PVar x -> Set.singleton x

M src/Pretty.hs => src/Pretty.hs +1 -0
@@ 158,6 158,7 @@ prettyPat = \case
    Parsed.PConstruction _ (Parsed.Id (WithPos _ c)) ps ->
        if null ps then c else concat ["(", c, " ", spcPretty ps, ")"]
    Parsed.PInt _ n -> show n
    Parsed.PUnit _ -> "unit"
    Parsed.PBool _ b -> if b then "true" else "false"
    Parsed.PStr _ s -> prettyStr s
    Parsed.PVar v -> Parsed.idstr v