93 lines
3.6 KiB
Text
93 lines
3.6 KiB
Text
/-
|
|
Copyright (c) 2019 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.expr init.data.option.basic
|
|
|
|
namespace lean
|
|
|
|
inductive extern_entry
|
|
| adhoc (backend : name)
|
|
| inline (backend : name) (pattern : string)
|
|
| standard (backend : name) (fn : string)
|
|
| foreign (backend : name) (fn : string)
|
|
|
|
@[export lean.mk_adhoc_ext_entry_core] def mk_adhoc_ext_entry := extern_entry.adhoc
|
|
@[export lean.mk_inline_ext_entry_core] def mk_inline_ext_entry := extern_entry.inline
|
|
@[export lean.mk_std_ext_entry_core] def mk_std_ext_entry := extern_entry.standard
|
|
@[export lean.mk_foreign_ext_entry_core] def mk_foreign_ext_entry := extern_entry.foreign
|
|
|
|
/-
|
|
- `@[extern]`
|
|
encoding: ```.entries = [adhoc `all]```
|
|
- `@[extern "level_hash"]`
|
|
encoding: ```.entries = [standard `all "level_hash"]```
|
|
- `@[extern cpp "lean::string_size" llvm "lean_str_size"]`
|
|
encoding: ```.entries = [standard `cpp "lean::string_size", standard `llvm "lean_str_size"]```
|
|
- `@[extern cpp inline "#1 + #2"]`
|
|
encoding: ```.entries = [inline `cpp "#1 + #2"]```
|
|
- `@[extern cpp "foo" llvm adhoc]`
|
|
encoding: ```.entries = [standard `cpp "foo", adhoc `llvm]```
|
|
- `@[extern 2 cpp "io_prim_println"]`
|
|
encoding: ```.arity = 2, .entries = [standard `cpp "io_prim_println"]```
|
|
-/
|
|
structure extern_attr_data :=
|
|
(arity : option nat := none)
|
|
(entries : list extern_entry)
|
|
|
|
@[export lean.mk_extern_attr_data_core] def mk_extern_attr_data := extern_attr_data.mk
|
|
|
|
/-
|
|
Remark: we only support pattern parameters: #1 to #9. This should be more than enough,
|
|
and it simplifies the expander.
|
|
-/
|
|
def expand_extern_pattern_aux (args : list string) : nat → string.iterator → string → string
|
|
| 0 it r := r
|
|
| (i+1) it r :=
|
|
if ¬ it.has_next then r
|
|
else let c := it.curr in
|
|
if c ≠ '#' then expand_extern_pattern_aux i it.next (r.push c)
|
|
else
|
|
let it := it.next in
|
|
let c := it.curr in
|
|
let j := c.to_nat - '0'.to_nat - 1 in
|
|
expand_extern_pattern_aux i it.next (r ++ (args.nth j).get_or_else "")
|
|
|
|
@[export lean.expand_extern_pattern_core]
|
|
def expand_extern_pattern (pattern : string) (args : list string) : string :=
|
|
expand_extern_pattern_aux args pattern.length pattern.mk_iterator ""
|
|
|
|
def mk_simple_fn_call (fn : string) (args : list string) : string :=
|
|
fn ++ "(" ++ ((args.intersperse ", ").foldl (++) "") ++ ")"
|
|
|
|
def expand_extern_entry : extern_entry → list string → option string
|
|
| (extern_entry.adhoc _) args := none -- backend must expand it
|
|
| (extern_entry.standard _ fn) args := some (mk_simple_fn_call fn args)
|
|
| (extern_entry.inline _ pat) args := some (expand_extern_pattern pat args)
|
|
| (extern_entry.foreign _ fn) args := some (mk_simple_fn_call fn args)
|
|
|
|
def extern_entry.backend : extern_entry → name
|
|
| (extern_entry.adhoc n) := n
|
|
| (extern_entry.inline n _) := n
|
|
| (extern_entry.standard n _) := n
|
|
| (extern_entry.foreign n _) := n
|
|
|
|
def get_extern_entry_for_aux (backend : name) : list extern_entry → option extern_entry
|
|
| [] := none
|
|
| (e::es) :=
|
|
if e.backend = `all then some e
|
|
else if e.backend = backend then some e
|
|
else get_extern_entry_for_aux es
|
|
|
|
@[export lean.get_extern_entry_for_core]
|
|
def get_extern_entry_for (d : extern_attr_data) (backend : name) : option extern_entry :=
|
|
get_extern_entry_for_aux backend d.entries
|
|
|
|
@[export lean.mk_extern_call_core]
|
|
def mk_extern_call (d : extern_attr_data) (backend : name) (args : list string) : option string :=
|
|
do e ← get_extern_entry_for d backend,
|
|
expand_extern_entry e args
|
|
|
|
end lean
|