177 lines
6.3 KiB
Text
177 lines
6.3 KiB
Text
/-
|
|
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
|
|
Released under Apache 2.0 license as described in the file LICENSE.
|
|
Authors: Leonardo de Moura
|
|
-/
|
|
prelude
|
|
import init.lean.ir.ir init.lean.parser.parser
|
|
import init.lean.parser.identifier init.lean.parser.string_literal
|
|
import init.lean.ir.reserved
|
|
|
|
namespace lean
|
|
namespace ir
|
|
open lean.parser
|
|
|
|
def symbol (s : string) : parser unit :=
|
|
(str s >> whitespace) <?> s
|
|
|
|
def keyword (s : string) : parser unit :=
|
|
(try $ str s >> not_followed_by_sat is_id_rest >> whitespace) <?> s
|
|
|
|
def parse_type : parser type :=
|
|
(keyword "bool" >> return type.bool)
|
|
<|> (keyword "byte" >> return type.byte)
|
|
<|> (keyword "uint16" >> return type.uint16)
|
|
<|> (keyword "uint32" >> return type.uint32)
|
|
<|> (keyword "uint64" >> return type.uint64)
|
|
<|> (keyword "int16" >> return type.int16)
|
|
<|> (keyword "int32" >> return type.int32)
|
|
<|> (keyword "int64" >> return type.int64)
|
|
<|> (keyword "float" >> return type.float)
|
|
<|> (keyword "double" >> return type.double)
|
|
<|> (keyword "object" >> return type.object)
|
|
|
|
def parse_unop : parser unop :=
|
|
(keyword "not" >> return unop.not)
|
|
<|> (keyword "neg" >> return unop.neg)
|
|
<|> (keyword "scalar" >> return unop.scalar)
|
|
<|> (keyword "shared" >> return unop.shared)
|
|
<|> (keyword "unbox" >> return unop.unbox)
|
|
<|> (keyword "box" >> return unop.box)
|
|
<|> (keyword "copy_array" >> return unop.copy_array)
|
|
<|> (keyword "copy_sarray" >> return unop.copy_sarray)
|
|
|
|
def parse_binop : parser binop :=
|
|
(keyword "add" >> return binop.add)
|
|
<|> (keyword "sub" >> return binop.sub)
|
|
<|> (keyword "mul" >> return binop.mul)
|
|
<|> (keyword "div" >> return binop.div)
|
|
<|> (keyword "mod" >> return binop.mod)
|
|
<|> (keyword "shl" >> return binop.shl)
|
|
<|> (keyword "shr" >> return binop.shr)
|
|
<|> (keyword "ashr" >> return binop.ashr)
|
|
<|> (keyword "and" >> return binop.and)
|
|
<|> (keyword "or" >> return binop.or)
|
|
<|> (keyword "xor" >> return binop.xor)
|
|
<|> (keyword "le" >> return binop.le)
|
|
<|> (keyword "ge" >> return binop.ge)
|
|
<|> (keyword "lt" >> return binop.lt)
|
|
<|> (keyword "gt" >> return binop.gt)
|
|
<|> (keyword "eq" >> return binop.eq)
|
|
<|> (keyword "ne" >> return binop.ne)
|
|
|
|
def parse_literal : parser literal :=
|
|
(keyword "tt" >> return (literal.bool tt))
|
|
<|> (keyword "ff" >> return (literal.bool ff))
|
|
<|> (do n ← lexeme num <?> "numeral", return (literal.num n))
|
|
<|> (do n ← (ch '-' >> lexeme num), return (literal.num (- n)))
|
|
<|> literal.str <$> parse_string_literal
|
|
|
|
def parse_uint16 : parser uint16 :=
|
|
try (do p ← pos,
|
|
n ← lexeme num,
|
|
when (n ≥ uint16_sz) $ unexpected_at "big numeral, it does not fit in an uint16" p,
|
|
return $ uint16.of_nat n)
|
|
<?> "uint16"
|
|
|
|
def identifier : parser name :=
|
|
try (do p ← pos,
|
|
n ← lean.parser.identifier,
|
|
when (is_reserved_name n) $ unexpected_at "keyword" p,
|
|
return n)
|
|
<?> "identifier"
|
|
|
|
def parse_var : parser var :=
|
|
lexeme identifier <?> "variable"
|
|
|
|
def parse_fnid : parser fnid :=
|
|
lexeme identifier <?> "function name"
|
|
|
|
def parse_blockid : parser blockid :=
|
|
lexeme identifier <?> "label"
|
|
|
|
def parse_nary_call (x : var) : parser instr :=
|
|
do xs ← many1 parse_var,
|
|
symbol ":=",
|
|
keyword "call",
|
|
fid ← parse_fnid,
|
|
ys ← many parse_var,
|
|
return $ instr.call ([x] ++ xs) fid ys
|
|
|
|
def parse_typed_assignment (x : var) : parser instr :=
|
|
do symbol ":",
|
|
ty ← parse_type,
|
|
symbol ":=",
|
|
(keyword "sget" >> instr.sget x ty <$> parse_var <*> parse_uint16)
|
|
<|> (keyword "sread" >> instr.sread x ty <$> parse_var <*> parse_var)
|
|
<|> (instr.unop x ty <$> parse_unop <*> parse_var)
|
|
<|> (instr.binop x ty <$> parse_binop <*> parse_var <*> parse_var)
|
|
<|> (instr.cast x ty <$> parse_var)
|
|
<|> (instr.lit x ty <$> parse_literal)
|
|
|
|
def parse_untyped_assignment (x : var) : parser instr :=
|
|
do symbol ":=",
|
|
(keyword "closure" >> instr.closure x <$> parse_fnid <*> many parse_var)
|
|
<|> (keyword "apply" >> instr.apply x <$> many1 parse_var)
|
|
<|> (keyword "read" >> instr.read x <$> parse_var <*> parse_var)
|
|
<|> (keyword "get" >> instr.get x <$> parse_var <*> parse_uint16)
|
|
<|> (keyword "read" >> instr.read x <$> parse_var <*> parse_var)
|
|
<|> (keyword "call" >> instr.call [x] <$> parse_fnid <*> many parse_var)
|
|
<|> (keyword "cnstr" >> instr.cnstr x <$> parse_uint16 <*> parse_uint16 <*> parse_uint16)
|
|
<|> (keyword "array" >> instr.array x <$> parse_var <*> parse_var)
|
|
<|> (keyword "sarray" >> instr.sarray x <$> parse_type <*> parse_var <*> parse_var)
|
|
|
|
def parse_assignment : parser instr :=
|
|
do x ← parse_var,
|
|
c ← curr,
|
|
if c = ':' then (parse_untyped_assignment x <|> parse_typed_assignment x)
|
|
else parse_nary_call x
|
|
|
|
def parse_instr : parser instr :=
|
|
(keyword "write" >> instr.write <$> parse_var <*> parse_var <*> parse_var)
|
|
<|> (keyword "swrite" >> instr.swrite <$> parse_var <*> parse_var <*> parse_var)
|
|
<|> (keyword "set" >> instr.set <$> parse_var <*> parse_uint16 <*> parse_var)
|
|
<|> (keyword "sset" >> instr.sset <$> parse_var <*> parse_uint16 <*> parse_var)
|
|
<|> (keyword "inc" >> instr.inc <$> parse_var)
|
|
<|> (keyword "dec" >> instr.dec <$> parse_var)
|
|
<|> (keyword "decs" >> instr.decs <$> parse_var)
|
|
<|> (keyword "free" >> instr.free <$> parse_var)
|
|
<|> parse_assignment
|
|
|
|
def parse_phi : parser phi :=
|
|
do (x, ty) ← try $ do { x ← parse_var, symbol ":", ty ← parse_type, symbol ":=", keyword "phi", return (x, ty) },
|
|
ys ← many1 parse_var,
|
|
return {x := x, ty := ty, ys := ys}
|
|
|
|
def parse_terminator : parser terminator :=
|
|
(keyword "jmp" >> terminator.jmp <$> parse_blockid)
|
|
<|> (keyword "ret" >> terminator.ret <$> many parse_var)
|
|
<|> (keyword "case" >> terminator.case <$> parse_var <*> many parse_blockid)
|
|
|
|
def parse_block : parser block :=
|
|
do id ← parse_blockid,
|
|
symbol ":",
|
|
ps ← many (parse_phi <* symbol ";"),
|
|
is ← many (parse_instr <* symbol ";"),
|
|
t ← parse_terminator <* symbol ";",
|
|
return { id := id, phis := ps, instrs := is, term := t }
|
|
|
|
def parse_arg : parser arg :=
|
|
do symbol "(", x ← parse_var, symbol ":", ty ← parse_type, symbol ")", return {n := x, ty := ty}
|
|
|
|
|
|
def parse_header : parser header :=
|
|
do n ← parse_fnid,
|
|
as ← many parse_arg,
|
|
symbol ":",
|
|
r ← many (result.mk <$> parse_type),
|
|
return { n := n, args := as, return := r }
|
|
|
|
def parse_def : parser decl :=
|
|
symbol "def" >> decl.defn <$> parse_header <*> (symbol ":=" >> many parse_block)
|
|
|
|
def parse_external : parser decl :=
|
|
symbol "external" >> decl.external <$> parse_header
|
|
|
|
end ir
|
|
end lean
|