├── .github └── workflows │ ├── update_versions.yml │ └── upgrade.yml ├── leanpkg.toml └── src ├── client2.py ├── lean_form.m ├── mathematica.lean ├── mathematica_parser.lean └── server2.m /.github/workflows/update_versions.yml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | 4 | jobs: 5 | update_lean_xyz_branch_and_build: 6 | runs-on: ubuntu-latest 7 | name: Update lean-x.y.z branch and build project 8 | steps: 9 | 10 | - name: checkout project 11 | uses: actions/checkout@v2 12 | with: 13 | fetch-depth: 0 14 | 15 | - name: update branch 16 | if: github.ref == 'refs/heads/master' 17 | uses: leanprover-contrib/update-versions-action@master 18 | 19 | - name: build project 20 | uses: leanprover-contrib/lean-build-action@master -------------------------------------------------------------------------------- /.github/workflows/upgrade.yml: -------------------------------------------------------------------------------- 1 | on: 2 | schedule: 3 | - cron: '0 2 * * *' 4 | 5 | jobs: 6 | upgrade_lean: 7 | runs-on: ubuntu-latest 8 | name: Bump Lean and dependency versions 9 | steps: 10 | - name: checkout project 11 | uses: actions/checkout@v2 12 | - name: upgrade Lean and dependencies 13 | uses: leanprover-contrib/lean-upgrade-action@master 14 | with: 15 | repo: ${{ github.repository }} 16 | access-token: ${{ secrets.GITHUB_TOKEN }} 17 | - name: update version branches 18 | uses: leanprover-contrib/update-versions-action@master -------------------------------------------------------------------------------- /leanpkg.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "mathematica" 3 | version = "0.1" 4 | lean_version = "leanprover-community/lean:3.49.1" 5 | path = "src" 6 | 7 | [dependencies] 8 | -------------------------------------------------------------------------------- /src/client2.py: -------------------------------------------------------------------------------- 1 | import socket 2 | import sys 3 | import subprocess 4 | import os 5 | import argparse 6 | import time 7 | import threading 8 | 9 | DETACHED_PROCESS = 0x00000008 10 | 11 | 12 | class ServerThread(threading.Thread): 13 | def run(self): 14 | #fnull=open(os.devnull,'w') 15 | #subprocess.Popen(["math", "--noprompt", "-run", '"<<\"~/Dropbox/lean/mathematica/server2.m\""'] 16 | # ,stdout=fnull, stdin=fnull, stderr=fnull 17 | #) 18 | os.system('wolfram -noprompt -run "< /dev/null') 19 | 20 | 21 | def restart_server(): 22 | fnull=open(os.devnull,'w') 23 | t = ServerThread() 24 | t.daemon=True 25 | t.start() 26 | # return subprocess.Popen(["math", "--noprompt", "-run", '"<<\"~/Dropbox/lean/mathematica/server2.m\""'] 27 | # ,stdout=fnull#, stdin=fnull, stderr=fnull 28 | # ) 29 | 30 | skt = 10000 31 | 32 | def process(s, is_global, start_server): 33 | sep = ' ' 34 | clientsocket = socket.socket(socket.AF_INET, socket.SOCK_STREAM) 35 | try: 36 | clientsocket.connect(('localhost', skt)) 37 | except socket.error as e: 38 | time.sleep(.2) 39 | print("error"), e 40 | if start_server: 41 | print("restarting server") 42 | pid = restart_server() 43 | # print pid.pid 44 | time.sleep(.5) 45 | # print pid.poll() 46 | clientsocket.connect(('localhost', skt)) 47 | else: 48 | return 49 | clientsocket.send((s + ("1" if is_global else "0")).encode('utf-8')) 50 | buf = '' 51 | while sep not in buf: 52 | buf += clientsocket.recv(1).decode('utf-8') 53 | splt = buf.split(sep, 1) 54 | num = int(splt[0]) 55 | recvd = 0 56 | buf = bytearray() 57 | while recvd < num: 58 | buf.extend(clientsocket.recv(1)) 59 | recvd += 1 60 | print(buf.decode('utf-8')) 61 | 62 | def read_from_file(path): 63 | f = open(path, "r") 64 | s = f.read() 65 | f.close() 66 | os.remove(path) 67 | return s 68 | 69 | parser = argparse.ArgumentParser(description="Communicate with Mathematica.") 70 | parser.add_argument('-f', action='store_true') # file 71 | parser.add_argument('-g', action='store_true') # global 72 | parser.add_argument('-b', action='store_true') # attempt to talk but don't start server 73 | parser.add_argument('-s', action='store_true') # only attempt to start server 74 | parser.add_argument('cmd') 75 | args = parser.parse_args() 76 | 77 | if args.s: 78 | restart_server() 79 | elif args.f: 80 | process(read_from_file(args.cmd), args.g, not args.b) 81 | else: 82 | process(args.cmd, args.g, not args.b) 83 | 84 | -------------------------------------------------------------------------------- /src/lean_form.m: -------------------------------------------------------------------------------- 1 | (* ::Package:: *) 2 | 3 | LeanName[s_String] := LeanNameMkString[s, LeanNameAnonymous]; 4 | LeanName[s_String, t_String] := LeanNameMkString[t, LeanName[s]]; 5 | LeanName[i_Int] := LeanNameMkNum[i, LeanNameAnonymous]; 6 | 7 | UnderscoreName[LeanNameMkString[s_String, t_]] := 8 | LeanNameMkString[s <> "_1", t]; 9 | UnderscoreName[LeanNameMkNum[i_Int, t_]] := 10 | LeanNameMkNum[1, LeanNameMkNum[i, t]]; 11 | 12 | StringOfName[LeanNameAnonymous] := ""; 13 | StringOfName[LeanNameMkString[s_String, LeanNameAnonymous]] := s; 14 | StringOfName[LeanNameMkString[s_String, t_]] := 15 | s <> "." <> StringOfName[t]; 16 | StringOfName[LeanNameMkNum[i_Int, LeanNameAnonymous]] := ToString[i]; 17 | StringOfName[LeanNameMkNum[i_Int, t_]] := 18 | ToString[i] <> "." <> StringOfName[t]; 19 | 20 | 21 | LeanForm[LeanApp[ 22 | LeanApp[LeanApp[ 23 | LeanApp[LeanConst[LeanName["has_add", "add"], _], _], _], x_], 24 | y_], v_] := Inactive[Plus][LeanForm[x, v], LeanForm[y, v]] 25 | 26 | LeanForm[LeanApp[ 27 | LeanApp[LeanApp[ 28 | LeanApp[LeanConst[LeanName["has_mul", "mul"], _], _], _], x_], 29 | y_], v_] := Inactive[Times][LeanForm[x, v], LeanForm[y, v]] 30 | 31 | LeanForm[LeanApp[ 32 | LeanApp[LeanApp[ 33 | LeanApp[LeanConst[LeanName["has_div", "div"], _], _], _], x_], 34 | y_], v_] := Inactive[Divide][LeanForm[x, v], LeanForm[y, v]] 35 | 36 | LeanForm[LeanApp[ 37 | LeanApp[LeanApp[ 38 | LeanApp[LeanConst[LeanName["has_sub", "sub"], _], _], _], x_], 39 | y_], v_] := Inactive[Subtract][LeanForm[x, v], LeanForm[y, v]] 40 | 41 | LeanForm[LeanApp[ 42 | LeanApp[LeanApp[LeanConst[LeanName["has_neg", "neg"], _], _], _], 43 | x_], v_] := Inactive[Times][-1, LeanForm[x, v]] 44 | LeanForm[LeanApp[ 45 | LeanApp[LeanApp[LeanApp[LeanConst[LeanName["add"], _], _], _], x_], 46 | y_], v_] := Inactive[Plus][LeanForm[x, v], LeanForm[y, v]] 47 | 48 | LeanForm[LeanApp[ 49 | LeanApp[LeanApp[LeanApp[LeanConst[LeanName["mul"], _], _], _], x_], 50 | y_], v_] := Inactive[Times][LeanForm[x, v], LeanForm[y, v]] 51 | 52 | LeanForm[LeanApp[ 53 | LeanApp[LeanApp[LeanApp[LeanConst[LeanName["div"], _], _], _], x_], 54 | y_], v_] := Inactive[Divide][LeanForm[x, v], LeanForm[y, v]] 55 | 56 | LeanForm[LeanApp[ 57 | LeanApp[LeanApp[LeanApp[LeanConst[LeanName["sub"], _], _], _], x_], 58 | y_], v_] := Inactive[Subtract][LeanForm[x, v], LeanForm[y, v]] 59 | 60 | LeanForm[LeanApp[ 61 | LeanApp[LeanApp[LeanConst[LeanName["neg"], _], _], _], x_], v_] := 62 | Inactive[Times][-1, LeanForm[x, v]] 63 | 64 | LeanForm[LeanApp[ 65 | LeanApp[LeanApp[LeanApp[LeanApp[LeanConst[LeanName["npow"], _], _], _], _], 66 | x_], y_], v_] := Inactive[Power][LeanForm[x, v], LeanForm[y, v]] 67 | 68 | LeanForm[LeanApp[LeanApp[LeanConst[LeanName["nat", "pow"], _], 69 | x_], y_], v_] := Inactive[Power][LeanForm[x, v], LeanForm[y, v]] 70 | 71 | LeanForm[LeanApp[LeanApp[LeanApp[LeanApp[LeanApp[LeanConst[LeanName["has_pow", "pow"], _], 72 | _], _], _], x_], y_], v_] := Inactive[Power][LeanForm[x, v], LeanForm[y, v]] 73 | 74 | LeanForm[LeanApp[LeanApp[LeanConst[LeanName["and"], _], x_], y_], 75 | v_] := Inactive[And][LeanForm[x, v], LeanForm[y, v]] 76 | 77 | LeanForm[LeanApp[LeanApp[LeanConst[LeanName["or"], _], x_], y_], v_] := 78 | Inactive[Or][LeanForm[x, v], LeanForm[y, v]] 79 | 80 | LeanForm[LeanApp[LeanApp[LeanConst[LeanName["implies"], _], x_], y_], 81 | v_] := Inactive[Implies][LeanForm[x, v], LeanForm[y, v]] 82 | 83 | LeanForm[LeanApp[LeanConst[LeanName["not"], _], x_], v_] := 84 | Inactive[Not][LeanForm[x, v]] 85 | 86 | LeanForm[LeanApp[LeanApp[LeanConst[LeanName["one"], _], _], _], 87 | v_] := 1 88 | 89 | LeanForm[LeanApp[LeanApp[LeanConst[LeanName["zero"], _], _], _], 90 | v_] := 0 91 | 92 | LeanForm[LeanApp[ 93 | LeanApp[LeanConst[LeanName["has_one", "one"], _], _], _], v_] := 1 94 | 95 | LeanForm[LeanApp[ 96 | LeanApp[LeanConst[LeanName["has_zero", "zero"], _], _], _], v_] := 0 97 | 98 | LeanForm[LeanApp[ 99 | LeanApp[LeanApp[LeanConst[LeanName["bit0"], _], _], _], t_], v_] := 100 | 2*LeanForm[t, v] 101 | 102 | LeanForm[LeanApp[ 103 | LeanApp[LeanApp[LeanApp[LeanConst[LeanName["bit1"], _], _], _], _], 104 | t_], v_] := 2*LeanForm[t, v] + 1 105 | 106 | LeanForm[LeanApp[LeanConst[LeanName["list", "nil"], _], _], v_] := {} 107 | 108 | LeanForm[LeanApp[ 109 | LeanApp[LeanApp[LeanConst[LeanName["list", "cons"], _], _], h_], 110 | t_], v_] := Prepend[LeanForm[t, v], LeanForm[h, v]] 111 | 112 | LeanForm[LeanApp[ 113 | LeanApp[LeanApp[LeanApp[LeanConst[LeanName["lt"], _], _], _], x_], 114 | y_], v_] := Inactive[Less][LeanForm[x, v], LeanForm[y, v]] 115 | 116 | LeanForm[LeanApp[ 117 | LeanApp[LeanApp[LeanApp[LeanConst[LeanName["le"], _], _], _], x_], 118 | y_], v_] := Inactive[LessEqual][LeanForm[x, v], LeanForm[y, v]] 119 | 120 | LeanForm[LeanApp[ 121 | LeanApp[LeanApp[LeanApp[LeanConst[LeanName["gt"], _], _], _], x_], 122 | y_], v_] := Inactive[Greater][LeanForm[x, v], LeanForm[y, v]] 123 | 124 | LeanForm[LeanApp[ 125 | LeanApp[LeanApp[LeanApp[LeanConst[LeanName["ge"], _], _], _], x_], 126 | y_], v_] := Inactive[GreaterEqual][LeanForm[x, v], LeanForm[y, v]] 127 | 128 | LeanForm[LeanApp[ 129 | LeanApp[LeanApp[ 130 | LeanApp[LeanConst[LeanName["has_lt", "lt"], _], _], _], x_], y_], 131 | v_] := Inactive[Less][LeanForm[x, v], LeanForm[y, v]] 132 | 133 | LeanForm[LeanApp[ 134 | LeanApp[LeanApp[ 135 | LeanApp[LeanConst[LeanName["has_le", "le"], _], _], _], x_], y_], 136 | v_] := Inactive[LessEqual][LeanForm[x, v], LeanForm[y, v]] 137 | 138 | LeanForm[LeanApp[ 139 | LeanApp[LeanApp[ 140 | LeanApp[LeanConst[LeanName["has_gt", "gt"], _], _], _], x_], y_], 141 | v_] := Inactive[Greater][LeanForm[x, v], LeanForm[y, v]] 142 | 143 | LeanForm[LeanApp[ 144 | LeanApp[LeanApp[ 145 | LeanApp[LeanConst[LeanName["has_ge", "ge"], _], _], _], x_], y_], 146 | v_] := Inactive[GreaterEqual][LeanForm[x, v], LeanForm[y, v]] 147 | 148 | LeanForm[LeanApp[ 149 | LeanApp[LeanApp[LeanConst[LeanName["eq"], _], _], x_], y_], 150 | v_] := Inactive[Equal][LeanForm[x, v], LeanForm[y, v]] 151 | 152 | LeanForm[LeanApp[LeanConst[LeanName["real","sin"],_],x_], v_] := Inactive[Sin][LeanForm[x, v]] 153 | LeanForm[LeanApp[LeanConst[LeanName["real","cos"],_],x_], v_] := Inactive[Cos][LeanForm[x, v]] 154 | LeanForm[LeanApp[LeanConst[LeanName["real","tan"],_],x_], v_] := Inactive[Tan][LeanForm[x, v]] 155 | LeanForm[LeanConst[LeanName["real","pi"], _], v_] := Pi 156 | 157 | LeanForm[LeanConst[LeanName["true"], _], v_] := True 158 | 159 | LeanForm[LeanSort[l_], v_] := LeanSort[l] 160 | 161 | LeanForm[LeanConst[a_, b_], v_] := LeanConst[a, b] 162 | 163 | LeanForm[LeanMetaVar[a_, b_], v_] := LeanMetaVar[a, b] 164 | 165 | (*LeanForm[LeanApp[f_, e_],v__] := LeanForm[f, v][LeanForm[e, v]]*) 166 | 167 | LeanForm[LeanLocal[n_, pn_, b_, t_], v_] := LeanLocal[n, pn, b, t] 168 | 169 | LeanForm[LeanPi[nm_, bi_, tp_, bod_], v_] := LeanPi[nm, bi, tp, bod] 170 | 171 | LeanForm[LeanLambda[nm_, bi_, tp_, bd_], v_] := 172 | If[MemberQ[v, Symbol[StringOfName[nm]]], 173 | LeanForm[LeanLambda[UnderscoreName[nm], bi, tp, bd], v], 174 | Apply[Function, 175 | List[Symbol[StringOfName[nm]], 176 | LeanForm[bd, Prepend[v, Symbol[StringOfName[nm]]]]]]] 177 | 178 | LeanForm[LeanVar[i_], v_] := If[Length[v]>i,v[[i+1]],LeanVar[i]] 179 | 180 | (*LeanForm[LeanApp[LeanLambda[nm_, bi_, tp_, bd_], e_], v_] := 181 | LeanForm[LeanLambda[nm, bi, tp, bd], v][LeanForm[e,v]]*) 182 | 183 | 184 | 185 | 186 | LeanForm[e_] := LeanForm[e, {}] 187 | 188 | OutputFormat[i_Integer] := "I[" <> ToString[i] <> "]" 189 | OutputFormat[s_String] := "T[\"" <> s <> "\"]" 190 | OutputFormat[s_Symbol] := "Y[" <> ToString[s] <> "]" 191 | OutputFormat[h_[args___]] := 192 | "A" <> OutputFormat[h] <> "[" <> 193 | StringRiffle[Map[OutputFormat, List[args]], ","] <> "]" 194 | 195 | 196 | MakeDataUrlFromImage[img_] := "data:image/png;base64," <> ExportString[ExportString[Graphics[img], "PNG"], "Base64"] 197 | 198 | 199 | PlotOverX[f_, {X_, lb_, ub_}] := Module[{nv, re}, 200 | re = f /. X -> nv; Plot[re, {nv, lb, ub}]] -------------------------------------------------------------------------------- /src/mathematica.lean: -------------------------------------------------------------------------------- 1 | /- 2 | Copyright (c) 2017 Robert Y. Lewis. All rights reserved. 3 | Released under Apache 2.0 license as described in the file LICENSE. 4 | Author: Robert Y. Lewis 5 | -/ 6 | 7 | 8 | import .mathematica_parser system.io 9 | open expr string level name binder_info native 10 | 11 | namespace list 12 | variables {α β : Type} 13 | universes u v w 14 | 15 | def for : list α → (α → β) → list β := flip map 16 | 17 | end list 18 | 19 | meta def rb_lmap.of_list {key : Type} {data : Type} [has_lt key] [decidable_rel ((<) : key → key → Prop)] : list (key × data) → rb_lmap key data 20 | | [] := rb_lmap.mk key data 21 | | ((k, v)::ls) := rb_lmap.insert (rb_lmap.of_list ls) k v 22 | 23 | meta def rb_map.insert_list {key : Type} {data : Type} : rb_map key data → list (key × data) → rb_map key data 24 | | m [] := m 25 | | m ((k, d) :: t) := rb_map.insert_list (rb_map.insert m k d) t 26 | 27 | local attribute [instance] htfi 28 | 29 | -- this has the expected behavior only if i is under the max size of unsigned 30 | def unsigned_of_int (i : int) : unsigned := 31 | int.rec_on i (λ k, unsigned.of_nat k) (λ k, unsigned.of_nat k) 32 | 33 | meta def expand_let : expr → expr 34 | | (elet nm tp val bod) := expr.replace bod (λ e n, match e with |var n := some val | _ := none end) 35 | | e := e 36 | 37 | /- 38 | The following definitions are used to reflect Lean syntax into Mathematica. We reflect the types 39 | - name 40 | - level 41 | - list level 42 | - binder_info 43 | - expr 44 | -/ 45 | namespace mathematica 46 | meta def form_of_name : name → string 47 | | anonymous := "LeanNameAnonymous" 48 | | (mk_string s nm) := "LeanNameMkString[\"" ++ s ++ "\", " ++ form_of_name nm ++ "]" 49 | | (mk_numeral i nm) := "LeanNameMkNum[" ++ to_string i ++ ", " ++ form_of_name nm ++ "]" 50 | 51 | meta def form_of_lvl : level → string 52 | | zero := "LeanZeroLevel" 53 | | (succ l) := "LeanLevelSucc[" ++ form_of_lvl l ++ "]" 54 | | (level.max l1 l2) := "LeanLevelMax[" ++ form_of_lvl l1 ++ ", " ++ form_of_lvl l2 ++ "]" 55 | | (imax l1 l2) := "LeanLevelIMax[" ++ form_of_lvl l1 ++ ", " ++ form_of_lvl l2 ++ "]" 56 | | (param nm) := "LeanLevelParam[" ++ form_of_name nm ++ "]" 57 | | (mvar nm) := "LeanLevelMeta[" ++ form_of_name nm ++ "]" 58 | 59 | meta def form_of_lvl_list : list level → string 60 | | [] := "LeanLevelListNil" 61 | | (h :: t) := "LeanLevelListCons[" ++ form_of_lvl h ++ ", " ++ form_of_lvl_list t ++ "]" 62 | 63 | meta def form_of_binder_info : binder_info → string 64 | | binder_info.default := "BinderInfoDefault" 65 | | implicit := "BinderInfoImplicit" 66 | | strict_implicit := "BinderInfoStrictImplicit" 67 | | inst_implicit := "BinderInfoInstImplicit" 68 | | other := "BinderInfoOther" 69 | 70 | /- 71 | let expressions get unfolded before translation. 72 | translating macro expressions is not supported. 73 | -/ 74 | meta def form_of_expr : expr → string 75 | | (var i) := "LeanVar[" ++ (format.to_string (to_fmt i) options.mk) ++ "]" 76 | | (sort lvl) := "LeanSort[" ++ form_of_lvl lvl ++ "]" 77 | | (const nm lvls) := "LeanConst[" ++ form_of_name nm ++ ", " ++ form_of_lvl_list lvls ++ "]" 78 | | (mvar nm nm' tp) := "LeanMetaVar[" ++ form_of_name nm ++ ", " ++ form_of_expr tp ++ "]" 79 | | (local_const nm ppnm bi tp) := "LeanLocal[" ++ form_of_name nm ++ ", " ++ 80 | form_of_name ppnm ++ ", " ++ form_of_binder_info bi ++ 81 | ", " ++ form_of_expr tp ++ "]" 82 | | (app f e) := "LeanApp[" ++ form_of_expr f ++ ", " ++ form_of_expr e ++ "]" 83 | | (lam nm bi tp bod) := "LeanLambda[" ++ form_of_name nm ++ ", " ++ 84 | form_of_binder_info bi ++ ", " ++ 85 | form_of_expr tp ++ ", " ++ form_of_expr bod ++ "]" 86 | | (pi nm bi tp bod) := "LeanPi[" ++ form_of_name nm ++ ", " ++ 87 | form_of_binder_info bi ++ ", " ++ form_of_expr tp ++ 88 | ", " ++ form_of_expr bod ++ "]" 89 | | (elet nm tp val bod) := form_of_expr $ expand_let $ elet nm tp val bod 90 | | (macro mdf mlst) := "LeanMacro" 91 | 92 | /- 93 | The following definitions are used to make pexprs out of various types. 94 | -/ 95 | end mathematica 96 | 97 | meta def pexpr_of_nat : ℕ → pexpr 98 | | 0 := ```(0) 99 | | 1 := ```(1) 100 | | k := if k%2=0 then ```(bit0 %%(pexpr_of_nat (k/2))) else ```(bit1 %%(pexpr_of_nat (k/2))) 101 | 102 | meta def pexpr_of_int : int → pexpr 103 | | (int.of_nat n) := pexpr_of_nat n 104 | | (int.neg_succ_of_nat n) := ```(-%%(pexpr_of_nat (n+1))) 105 | 106 | 107 | namespace tactic 108 | namespace mathematica 109 | 110 | section 111 | 112 | def write_file (fn : string) (cnts : string) (mode := io.mode.write) : io unit := do 113 | h ← io.mk_file_handle fn io.mode.write, 114 | io.fs.write h cnts.to_char_buffer, 115 | io.fs.close h 116 | 117 | end 118 | 119 | /-- 120 | execute str evaluates str in Mathematica. 121 | The evaluation happens in a unique context; declarations that are made during 122 | evaluation will not be available in future evaluations. 123 | -/ 124 | meta def execute (cmd : string) (add_args : list string := []) : tactic char_buffer := 125 | let cmd' := escape_term cmd ++ "&!", 126 | args := ["_target/deps/mathematica/src/client2.py"].append add_args in 127 | if cmd'.length < 2040 then 128 | tactic.unsafe_run_io $ io.buffer_cmd { cmd := "python3", args := args.append [/-escape_quotes -/cmd'] } 129 | else do 130 | path ← mathematica.temp_file_name "exch", 131 | unsafe_run_io $ write_file path cmd' io.mode.write, 132 | unsafe_run_io $ io.buffer_cmd { cmd := "python3", args := args.append ["-f", path] } 133 | def get_cwd : io string := io.cmd {cmd := "pwd"} >>= λ s, pure $ strip_newline s 134 | 135 | meta def execute_and_eval (cmd : string) : tactic mmexpr := 136 | execute cmd >>= parse_mmexpr_tac 137 | 138 | /-- 139 | execute_global str evaluates str in Mathematica. 140 | The evaluation happens in the global context; declarations that are made during 141 | evaluation will persist. 142 | -/ 143 | meta def execute_global (cmd : string) : tactic char_buffer := 144 | execute cmd ["-g"] 145 | 146 | /-- 147 | Returns the path to {run_directory}/extras/ 148 | -/ 149 | meta def extras_path : tactic string := 150 | unsafe_run_io get_cwd >>= 151 | λ s, pure $ strip_trailing_whitespace s ++ "/src/extras/" 152 | 153 | end mathematica 154 | end tactic 155 | 156 | 157 | namespace mathematica 158 | open mmexpr tactic 159 | 160 | 161 | private meta def pexpr_mk_app : pexpr → list pexpr → pexpr 162 | | fn [] := fn 163 | | fn (h::t) := pexpr_mk_app (app fn h) t 164 | 165 | section translation 166 | open rb_lmap 167 | 168 | 169 | @[reducible] meta def trans_env := rb_map string expr 170 | meta def trans_env.empty := rb_map.mk string expr 171 | 172 | meta def sym_trans_pexpr_rule := string × pexpr 173 | meta def sym_trans_expr_rule := string × expr 174 | meta def app_trans_pexpr_keyed_rule := string × (trans_env → list mmexpr → tactic pexpr) 175 | meta def app_trans_expr_keyed_rule := string × (trans_env → list mmexpr → tactic expr) 176 | meta def app_trans_pexpr_unkeyed_rule := trans_env → mmexpr → list mmexpr → tactic pexpr 177 | meta def app_trans_expr_unkeyed_rule := trans_env → mmexpr → list mmexpr → tactic expr 178 | 179 | -- databases 180 | 181 | private meta def mk_sym_trans_pexpr_db (l : list name) : tactic (rb_lmap string pexpr) := 182 | do dcls ← monad.mapm (λ n, mk_const n >>= eval_expr sym_trans_pexpr_rule) l, 183 | return $ of_list dcls 184 | 185 | private meta def mk_sym_trans_expr_db (l : list name) : tactic (rb_lmap string expr) := 186 | do dcls ← monad.mapm (λ n, mk_const n >>= eval_expr sym_trans_expr_rule) l, 187 | return $ of_list dcls 188 | 189 | private meta def mk_app_trans_pexpr_keyed_db (l : list name) : 190 | tactic (rb_lmap string (trans_env → list mmexpr → tactic pexpr)) := 191 | do dcls ← monad.mapm (λ n, mk_const n >>= eval_expr app_trans_pexpr_keyed_rule) l, 192 | return $ of_list dcls 193 | 194 | private meta def mk_app_trans_expr_keyed_db (l : list name) : 195 | tactic (rb_lmap string (trans_env → list mmexpr → tactic expr)) := 196 | do dcls ← monad.mapm (λ n, mk_const n >>= eval_expr app_trans_expr_keyed_rule) l, 197 | return $ of_list dcls 198 | 199 | private meta def mk_app_trans_pexpr_unkeyed_db (l : list name) : 200 | tactic (list (trans_env → mmexpr → list mmexpr → tactic pexpr)) := 201 | monad.mapm (λ n, mk_const n >>= eval_expr app_trans_pexpr_unkeyed_rule) l 202 | 203 | private meta def mk_app_trans_expr_unkeyed_db (l : list name) : 204 | tactic (list (trans_env → mmexpr → list mmexpr → tactic expr)) := 205 | monad.mapm (λ n, mk_const n >>= eval_expr app_trans_expr_unkeyed_rule) l 206 | 207 | meta def ensure_has_type (e : expr) : name → nat → bool → command := 208 | λ decl_name _ _, 209 | do dcl ← get_decl decl_name, 210 | is_def_eq e (dcl.type) 211 | 212 | @[user_attribute] 213 | private meta def sym_to_pexpr_rule : user_attribute (rb_lmap string pexpr) unit := 214 | { name := `sym_to_pexpr, 215 | descr := "rule for translating a mmexpr.sym to a pexpr", 216 | cache_cfg := ⟨mk_sym_trans_pexpr_db, []⟩, 217 | after_set := ensure_has_type `(sym_trans_pexpr_rule) } 218 | 219 | @[user_attribute] 220 | private meta def sym_to_expr_rule : user_attribute (rb_lmap string expr) unit := 221 | { name := `sym_to_expr, 222 | descr := "rule for translating a mmexpr.sym to a expr", 223 | cache_cfg := ⟨mk_sym_trans_expr_db, []⟩, 224 | after_set := ensure_has_type `(sym_trans_expr_rule) } 225 | 226 | @[user_attribute] 227 | private meta def app_to_pexpr_keyed_rule : 228 | user_attribute (rb_lmap string (trans_env → list mmexpr → tactic pexpr)) := 229 | { name := `app_to_pexpr_keyed, 230 | descr := "rule for translating a mmexpr.app to a pexpr", 231 | cache_cfg := ⟨mk_app_trans_pexpr_keyed_db, []⟩, 232 | after_set := ensure_has_type `(app_trans_pexpr_keyed_rule) } 233 | 234 | @[user_attribute] 235 | private meta def app_to_expr_keyed_rule : 236 | user_attribute (rb_lmap string (trans_env → list mmexpr → tactic expr)) := 237 | { name := `app_to_expr_keyed, 238 | descr := "rule for translating a mmexpr.app to a expr", 239 | cache_cfg := ⟨mk_app_trans_expr_keyed_db, []⟩, 240 | after_set := ensure_has_type `(app_trans_expr_keyed_rule) } 241 | 242 | @[user_attribute] 243 | private meta def app_to_pexpr_unkeyed_rule : 244 | user_attribute (list (trans_env → mmexpr → list mmexpr → tactic pexpr)) := 245 | { name := `app_to_pexpr_unkeyed, 246 | descr := "rule for translating a mmexpr.app to a pexpr", 247 | cache_cfg := ⟨mk_app_trans_pexpr_unkeyed_db, []⟩, 248 | after_set := ensure_has_type `(app_trans_pexpr_unkeyed_rule) } 249 | 250 | @[user_attribute] 251 | private meta def app_to_expr_unkeyed_rule : 252 | user_attribute (list (trans_env → mmexpr → list mmexpr → tactic expr)) := 253 | { name := `app_to_expr_unkeyed, 254 | descr := "rule for translating a mmexpr.app to a expr", 255 | cache_cfg := ⟨mk_app_trans_expr_unkeyed_db, []⟩, 256 | after_set := ensure_has_type `(app_trans_expr_unkeyed_rule) } 257 | 258 | 259 | private meta def expr_of_mmexpr_app_keyed (env : trans_env) : mmexpr → list mmexpr → tactic expr 260 | | (sym hd) args := 261 | do expr_db ← app_to_expr_keyed_rule.get_cache, 262 | tactic.first $ (rb_lmap.find expr_db hd).for $ λ f, f env args 263 | | _ _ := failed 264 | 265 | private meta def expr_of_mmexpr_app_unkeyed (env : trans_env) (hd : mmexpr) (args : list mmexpr) : tactic expr := 266 | do expr_db ← app_to_expr_unkeyed_rule.get_cache, 267 | tactic.first (list.map (λ f : trans_env → mmexpr → list mmexpr → tactic expr, f env hd args) expr_db) 268 | 269 | private meta def expr_of_mmexpr_app (env : trans_env) (expr_of_mmexpr : trans_env → mmexpr → tactic expr) 270 | (m : mmexpr) (l : list mmexpr) : tactic expr := 271 | expr_of_mmexpr_app_keyed env m l <|> 272 | expr_of_mmexpr_app_unkeyed env m l 273 | 274 | private meta def pexpr_of_mmexpr_app_keyed (env : trans_env) : mmexpr → list mmexpr → tactic pexpr 275 | | (sym hd) args := 276 | do expr_db ← app_to_pexpr_keyed_rule.get_cache, 277 | tactic.first $ (rb_lmap.find expr_db hd).for $ λ f, f env args 278 | | _ _ := failed 279 | 280 | 281 | private meta def pexpr_of_mmexpr_app_unkeyed (env : trans_env) (hd : mmexpr) (args : list mmexpr) : tactic pexpr := 282 | do expr_db ← app_to_pexpr_unkeyed_rule.get_cache, 283 | tactic.first (list.map (λ f : trans_env → mmexpr → list mmexpr → tactic pexpr, f env hd args) expr_db) 284 | 285 | private meta def pexpr_of_mmexpr_app_decomp (env : trans_env) (pexpr_of_mmexpr : trans_env → mmexpr → tactic pexpr) 286 | (hd : mmexpr) (args : list mmexpr) : tactic pexpr := 287 | do hs ← pexpr_of_mmexpr env hd, 288 | args' ← monad.mapm (pexpr_of_mmexpr env) args, 289 | return $ pexpr_mk_app hs args' 290 | 291 | private meta def pexpr_of_mmexpr_app (env : trans_env) (pexpr_of_mmexpr : trans_env → mmexpr → tactic pexpr) 292 | (m : mmexpr) (l : list mmexpr) : tactic pexpr := 293 | pexpr_of_mmexpr_app_keyed env m l <|> 294 | pexpr_of_mmexpr_app_unkeyed env m l <|> 295 | pexpr_of_mmexpr_app_decomp env pexpr_of_mmexpr m l 296 | 297 | private meta def find_in_env (env : trans_env) (sym : string) : tactic expr := 298 | match rb_map.find env sym with 299 | | some e := return e 300 | | none := failed 301 | end 302 | 303 | /-- 304 | expr_of_mmexpr env m will attempt to translate m to an expr, using translation rules found by 305 | the attribute manager. env maps symbols (representing bound variables) to placeholder exprs. 306 | -/ 307 | meta def expr_of_mmexpr : trans_env → mmexpr → tactic expr 308 | | env (sym s) := find_in_env env s <|> 309 | do expr_db ← sym_to_expr_rule.get_cache, 310 | match rb_lmap.find expr_db s with 311 | | (h :: t) := return h 312 | | [] := fail ("Couldn't find translation for sym \"" ++ s ++ "\"") 313 | end 314 | | env (mstr s) := return (string.reflect s)--to_expr (_root_.quote s) 315 | | env (mreal r) := return (reflect r) 316 | | env (app hd args) := expr_of_mmexpr_app env expr_of_mmexpr hd args 317 | | env (mint i) := failed 318 | 319 | private meta def pexpr_of_mmexpr_aux (env : trans_env) 320 | (pexpr_of_mmexpr : trans_env → mmexpr → tactic pexpr) : mmexpr → tactic pexpr 321 | | (sym s) := 322 | do expr_db ← sym_to_pexpr_rule.get_cache, 323 | match rb_lmap.find expr_db s with 324 | | (h :: t) := return h 325 | | [] := parse_name_tac s >>= resolve_name <|> fail ("Couldn't find translation for sym \"" ++ s ++ "\"") 326 | end 327 | | (mint i ) := return $ pexpr_of_int i 328 | | (app hd args) := pexpr_of_mmexpr_app env pexpr_of_mmexpr hd args 329 | | (mstr s) := fail "unreachable, str case shouldn't reach pexpr_of_mmexpr_aux" 330 | | (mreal r) := fail "unreachable, real case shouldn't reach pexpr_of_mmexpr_aux" 331 | 332 | /-- 333 | pexpr_of_mmexpr env m will attempt to translate m to a pexpr, using translation rules found by 334 | the attribute manager. env maps symbols (representing bound variables) to placeholder exprs. 335 | -/ 336 | meta def pexpr_of_mmexpr : trans_env → mmexpr → tactic pexpr := 337 | λ env m, (do e ← expr_of_mmexpr env m, return ```(%%e)) <|> 338 | (pexpr_of_mmexpr_aux env pexpr_of_mmexpr m) 339 | 340 | end translation 341 | 342 | section unreflect 343 | 344 | meta def level_of_mmexpr : mmexpr → tactic level 345 | | (sym "LeanZeroLevel") := return $ level.zero 346 | | (app (sym "LeanLevelSucc") [m]) := do m' ← level_of_mmexpr m, return $ level.succ m' 347 | | (app (sym "LeanLevelMax") [m1, m2]) := 348 | do m1' ← level_of_mmexpr m1, 349 | m2' ← level_of_mmexpr m2, 350 | return $ level.max m1' m2' 351 | | (app (sym "LeanLevelIMax") [m1, m2]) := 352 | do m1' ← level_of_mmexpr m1, 353 | m2' ← level_of_mmexpr m2, 354 | return $ level.imax m1' m2' 355 | | (app (sym "LeanLevelParam") [mstr s]) := return $ level.param s 356 | | (app (sym "LeanLevelMeta") [mstr s]) := return $ level.mvar s 357 | | _ := failed 358 | 359 | meta def level_list_of_mmexpr : mmexpr → tactic (list level) 360 | | (sym "LeanLevelListNil") := return [] 361 | | (app (sym "LeanLevelListCons") [h, t]) := 362 | do h' ← level_of_mmexpr h, 363 | t' ← level_list_of_mmexpr t, 364 | return $ h' :: t' 365 | | _ := failed 366 | 367 | meta def name_of_mmexpr : mmexpr → tactic name 368 | | (sym "LeanNameAnonymous") := return $ name.anonymous 369 | | (app (sym "LeanNameMkString") [mstr s, m]) := 370 | do n ← name_of_mmexpr m, return $ name.mk_string s n 371 | | (app (sym "LeanNameMkNum") [mint i, m]) := 372 | do n ← name_of_mmexpr m, return $ name.mk_numeral (unsigned_of_int i) n 373 | | _ := failed 374 | 375 | meta def binder_info_of_mmexpr : mmexpr → tactic binder_info 376 | | (sym "BinderInfoDefault") := return $ binder_info.default 377 | | (sym "BinderInfoImplicit") := return $ binder_info.implicit 378 | | (sym "BinderInfoStrictImplicit") := return $ binder_info.strict_implicit 379 | | (sym "BinderInfoInstImplicit") := return $ binder_info.inst_implicit 380 | | (sym "BinderInfoOther") := return $ binder_info.aux_decl 381 | | _ := failed 382 | end unreflect 383 | 384 | section transl_expr_instances 385 | 386 | @[app_to_expr_keyed] 387 | meta def mmexpr_var_to_expr : app_trans_expr_keyed_rule := 388 | ⟨"LeanVar", 389 | λ _ args, match args with 390 | | [mint i] := return $ var (i.nat_abs) 391 | | _ := failed 392 | end⟩ 393 | 394 | @[app_to_expr_keyed] 395 | meta def mmexpr_sort_to_expr : app_trans_expr_keyed_rule := 396 | ⟨"LeanSort", 397 | λ _ args, match args with 398 | | [m] := do lvl ← level_of_mmexpr m, return $ sort lvl 399 | | _ := failed 400 | end⟩ 401 | 402 | @[app_to_expr_keyed] 403 | meta def mmexpr_const_to_expr : app_trans_expr_keyed_rule := 404 | ⟨"LeanConst", 405 | λ _ args, match args with 406 | | [nm, lvls] := do nm' ← name_of_mmexpr nm, lvls' ← level_list_of_mmexpr lvls, return $ const nm' lvls' 407 | | _ := failed 408 | end⟩ 409 | 410 | @[app_to_expr_keyed] 411 | meta def mmexpr_mvar_to_expr : app_trans_expr_keyed_rule := 412 | ⟨"LeanMetaVar", 413 | λ env args, match args with 414 | | [nm, tp] := do nm' ← name_of_mmexpr nm, tp' ← expr_of_mmexpr env tp, return $ mvar nm' `workaround tp' 415 | | _ := failed 416 | end⟩ 417 | 418 | @[app_to_expr_keyed] 419 | meta def mmexpr_local_to_expr : app_trans_expr_keyed_rule := 420 | ⟨"LeanLocal", 421 | λ env args, match args with 422 | | [nm, ppnm, bi, tp] := 423 | do nm' ← name_of_mmexpr nm, 424 | ppnm' ← name_of_mmexpr ppnm, 425 | bi' ← binder_info_of_mmexpr bi, 426 | tp' ← expr_of_mmexpr env tp, 427 | return $ expr.local_const nm' ppnm' bi' tp' 428 | | _ := failed 429 | end⟩ 430 | 431 | @[app_to_expr_keyed] 432 | meta def mmexpr_app_to_expr : app_trans_expr_keyed_rule := 433 | ⟨"LeanApp", 434 | λ env args, match args with 435 | | [hd, bd] := do hd' ← expr_of_mmexpr env hd, bd' ← expr_of_mmexpr env bd, return $ expr.app hd' bd' 436 | | _ := failed 437 | end⟩ 438 | 439 | @[app_to_expr_keyed] 440 | meta def mmexpr_lam_to_expr : app_trans_expr_keyed_rule := 441 | ⟨"LeanLambda", 442 | λ env args, match args with 443 | | [nm, bi, tp, bd] := 444 | do nm' ← name_of_mmexpr nm, 445 | bi' ← binder_info_of_mmexpr bi, 446 | tp' ← expr_of_mmexpr env tp, 447 | bd' ← expr_of_mmexpr env bd, 448 | return $ lam nm' bi' tp' bd' 449 | | _ := failed 450 | end⟩ 451 | 452 | @[app_to_expr_keyed] 453 | meta def mmexpr_pi_to_expr : app_trans_expr_keyed_rule := 454 | ⟨"LeanPi", 455 | λ env args, match args with 456 | | [nm, bi, tp, bd] := 457 | do nm' ← name_of_mmexpr nm, 458 | bi' ← binder_info_of_mmexpr bi, 459 | tp' ← expr_of_mmexpr env tp, 460 | bd' ← expr_of_mmexpr env bd, 461 | return $ lam nm' bi' tp' bd' 462 | | _ := failed 463 | end⟩ 464 | 465 | meta def pexpr_fold_op_aux (op : pexpr) : pexpr → list pexpr → pexpr 466 | | e [] := e 467 | | e (h::t) := pexpr_fold_op_aux ```(%%op %%e %%h) t 468 | 469 | meta def pexpr_fold_op (dflt op : pexpr) : list pexpr → pexpr 470 | | [] := dflt 471 | | [h] := h 472 | | (h::t) := pexpr_fold_op_aux op h t 473 | 474 | -- pexpr instances 475 | 476 | @[app_to_pexpr_keyed] 477 | meta def add_to_pexpr : app_trans_pexpr_keyed_rule := 478 | ⟨"Plus", 479 | λ env args, do args' ← monad.mapm (pexpr_of_mmexpr env) args, return $ pexpr_fold_op ```(0) ```(has_add.add) args'⟩ 480 | 481 | @[app_to_pexpr_keyed] 482 | meta def mul_to_pexpr : app_trans_pexpr_keyed_rule := 483 | ⟨"Times", 484 | λ env args, do args' ← monad.mapm (pexpr_of_mmexpr env) args, return $ pexpr_fold_op ```(1) ```(has_mul.mul) args'⟩ 485 | 486 | @[app_to_pexpr_keyed] 487 | meta def power_to_pexpr : app_trans_pexpr_keyed_rule := 488 | ⟨"Power", 489 | λ env args, 490 | match args with 491 | | [base, exp] := do base ← pexpr_of_mmexpr env base, exp ← pexpr_of_mmexpr env exp, return ``(%%base ^ %%exp) 492 | | _ := failed 493 | end⟩ 494 | 495 | @[app_to_pexpr_keyed] 496 | meta def list_to_pexpr : app_trans_pexpr_keyed_rule := 497 | ⟨"List", λ env args, 498 | do args' ← monad.mapm (pexpr_of_mmexpr env) args, 499 | return $ list.foldr (λ h t, ```(%%h :: %%t)) ```([]) args'⟩ 500 | 501 | @[app_to_pexpr_keyed] 502 | meta def and_to_pexpr : app_trans_pexpr_keyed_rule := 503 | ⟨"And", 504 | λ env args, do args' ← monad.mapm (pexpr_of_mmexpr env) args, return $ pexpr_fold_op ```(true) ```(and) args'⟩ 505 | 506 | @[app_to_pexpr_keyed] 507 | meta def or_to_pexpr : app_trans_pexpr_keyed_rule := 508 | ⟨"Or", 509 | λ env args, do args' ← monad.mapm (pexpr_of_mmexpr env) args, return $ pexpr_fold_op ```(false) ```(or) args'⟩ 510 | 511 | @[app_to_pexpr_keyed] 512 | meta def not_to_pexpr : app_trans_pexpr_keyed_rule := 513 | ⟨"Not", 514 | λ env args, match args with 515 | | [t] := do t' ← pexpr_of_mmexpr env t, return ```(¬ %%t') 516 | | _ := failed 517 | end⟩ 518 | 519 | @[app_to_pexpr_keyed] 520 | meta def implies_to_pexpr : app_trans_pexpr_keyed_rule := 521 | ⟨"Implies", 522 | λ env args, match args with 523 | | [h,c] := do h' ← pexpr_of_mmexpr env h, c' ← pexpr_of_mmexpr env c, return $ ```(%%h' → %%c') 524 | | _ := failed 525 | end⟩ 526 | 527 | @[app_to_pexpr_keyed] 528 | meta def hold_to_pexpr : app_trans_pexpr_keyed_rule := 529 | ⟨"Hold", 530 | λ env args, match args with 531 | | [h] := pexpr_of_mmexpr env h 532 | | _ := failed 533 | end⟩ 534 | 535 | private meta def replace_holds : mmexpr → list mmexpr 536 | | (app (sym "Hold") l) := l 537 | | m := [m] 538 | 539 | meta def is_hold : mmexpr → bool 540 | | (app (sym "Hold") l) := tt 541 | | _ := ff 542 | 543 | /-- 544 | F[Hold[a1, ..., an]] is equivalent to F[a1, ..., an]. 545 | F[t1, ..., Hold[p, q], ..., tn] is equivalent to F[t1, ..., p, q, ..., tn] 546 | -/ 547 | @[app_to_pexpr_unkeyed] 548 | meta def app_mvar_hold_to_pexpr : app_trans_pexpr_unkeyed_rule 549 | | env head [app (sym "Hold") l] := pexpr_of_mmexpr env (app head l) 550 | | env head l := 551 | if l.any is_hold then 552 | let ls := (l.map replace_holds).join in pexpr_of_mmexpr env (app head ls) 553 | else failed 554 | 555 | @[app_to_pexpr_unkeyed] 556 | meta def app_inactive_to_pexpr : app_trans_pexpr_unkeyed_rule 557 | | env (app (sym "Inactive") [t]) l := pexpr_of_mmexpr env (app t l) 558 | | _ _ _ := failed 559 | 560 | 561 | meta def pexpr.to_raw_expr : pexpr → expr 562 | | (var n) := var n 563 | | (sort l) := sort l 564 | | (const nm ls) := const nm ls 565 | | (mvar n n' e) := mvar n n' (pexpr.to_raw_expr e) 566 | | (local_const nm ppnm bi tp) := local_const nm ppnm bi (pexpr.to_raw_expr tp) 567 | | (app f a) := app (pexpr.to_raw_expr f) (pexpr.to_raw_expr a) 568 | | (lam nm bi tp bd) := lam nm bi (pexpr.to_raw_expr tp) (pexpr.to_raw_expr bd) 569 | | (pi nm bi tp bd) := pi nm bi (pexpr.to_raw_expr tp) (pexpr.to_raw_expr bd) 570 | | (elet nm tp df bd) := elet nm (pexpr.to_raw_expr tp) (pexpr.to_raw_expr df) (pexpr.to_raw_expr bd) 571 | | (macro md l) := macro md (l.map pexpr.to_raw_expr) 572 | 573 | meta def pexpr.of_raw_expr : expr → pexpr 574 | | (var n) := var n 575 | | (sort l) := sort l 576 | | (const nm ls) := const nm ls 577 | | (mvar n n' e) := mvar n n' (pexpr.of_raw_expr e) 578 | | (local_const nm ppnm bi tp) := local_const nm ppnm bi (pexpr.of_raw_expr tp) 579 | | (app f a) := app (pexpr.of_raw_expr f) (pexpr.of_raw_expr a) 580 | | (lam nm bi tp bd) := lam nm bi (pexpr.of_raw_expr tp) (pexpr.of_raw_expr bd) 581 | | (pi nm bi tp bd) := pi nm bi (pexpr.of_raw_expr tp) (pexpr.of_raw_expr bd) 582 | | (elet nm tp df bd) := elet nm (pexpr.of_raw_expr tp) (pexpr.of_raw_expr df) (pexpr.of_raw_expr bd) 583 | | (macro md l) := macro md (l.map pexpr.of_raw_expr) 584 | 585 | 586 | meta def mk_local_const_placeholder (n : name) : expr := 587 | let t := pexpr.mk_placeholder in 588 | local_const n n binder_info.default (pexpr.to_raw_expr t) 589 | 590 | meta def mk_local_const (n : name) (tp : pexpr): expr := 591 | local_const n n binder_info.default (pexpr.to_raw_expr tp) 592 | 593 | private meta def sym_to_lcs_using (env : trans_env) (e : mmexpr) : mmexpr → tactic (string × expr) 594 | | (sym s) := do p ← pexpr_of_mmexpr env e, 595 | return $ (s, mk_local_const s p) 596 | | _ := failed 597 | 598 | meta def sym_to_lcp : mmexpr → tactic (string × expr) 599 | | (sym s) := return $ (s, mk_local_const_placeholder s) 600 | | _ := failed 601 | 602 | meta def mk_lambdas (l : list expr) (b : pexpr) : pexpr := 603 | pexpr.of_raw_expr (lambdas l (pexpr.to_raw_expr b)) 604 | 605 | meta def mk_lambda' (x : expr) (b : pexpr) : pexpr := 606 | pexpr.of_raw_expr (lambdas [x] (pexpr.to_raw_expr b)) 607 | 608 | meta def mk_pis (l : list expr) (b : pexpr) : pexpr := 609 | pexpr.of_raw_expr (pis l (pexpr.to_raw_expr b)) 610 | 611 | meta def mk_pi' (x : expr) (b : pexpr) : pexpr := 612 | pexpr.of_raw_expr (pis [x] (pexpr.to_raw_expr b)) 613 | 614 | @[app_to_pexpr_keyed] 615 | meta def function_to_pexpr : app_trans_pexpr_keyed_rule := 616 | ⟨"Function", 617 | λ env args, match args with 618 | | [sym x, bd] := 619 | do v ← return $ mk_local_const_placeholder x, 620 | bd' ← pexpr_of_mmexpr (env.insert x v) bd, 621 | return $ mk_lambda' v bd' 622 | | [app (sym "List") l, bd] := 623 | do vs ← monad.mapm sym_to_lcp l, 624 | bd' ← pexpr_of_mmexpr (rb_map.insert_list env vs) bd, 625 | return $ mk_lambdas (list.map prod.snd vs) bd' 626 | | _ := failed 627 | end⟩ 628 | 629 | @[app_to_pexpr_keyed] 630 | meta def forall_to_pexpr : app_trans_pexpr_keyed_rule := 631 | ⟨"ForAll", 632 | λ env args, match args with 633 | | [sym x, bd] := 634 | do v ← return $ mk_local_const_placeholder x, 635 | bd' ← pexpr_of_mmexpr (env.insert x v) bd, 636 | return $ mk_pi' v bd' 637 | | [app (sym "List") l, bd] := 638 | do vs ← monad.mapm sym_to_lcp l, 639 | bd' ← pexpr_of_mmexpr (rb_map.insert_list env vs) bd, 640 | return $ mk_pis (list.map prod.snd vs) bd' 641 | | [sym x, t, bd] := 642 | do v ← return $ mk_local_const_placeholder x, 643 | bd' ← pexpr_of_mmexpr (env.insert x v) (app (sym "Implies") [t,bd]), 644 | return $ mk_pi' v bd' 645 | | _ := failed 646 | end⟩ 647 | 648 | @[app_to_pexpr_keyed] 649 | meta def forall_typed_to_pexpr : app_trans_pexpr_keyed_rule := 650 | ⟨"ForAllTyped", 651 | λ env args, match args with 652 | | [sym x, t, bd] := 653 | do (n, pe) ← sym_to_lcs_using env t (sym x), 654 | bd' ← pexpr_of_mmexpr (env.insert n pe) bd, 655 | return $ mk_pi' pe bd' 656 | | [app (sym "List") l, t, bd] := 657 | do vs ← monad.mapm (sym_to_lcs_using env t) l, 658 | bd' ← pexpr_of_mmexpr (rb_map.insert_list env vs) bd, 659 | return $ mk_pis (vs.map prod.snd) bd' 660 | | _ := failed 661 | end⟩ 662 | 663 | @[app_to_pexpr_keyed] 664 | meta def exists_to_pexpr : app_trans_pexpr_keyed_rule := 665 | ⟨"Exists", 666 | λ env args, match args with 667 | | [sym x, bd] := 668 | do v ← return $ mk_local_const_placeholder x, 669 | bd' ← pexpr_of_mmexpr (env.insert x v) bd, 670 | lm ← return $ mk_lambda' v bd', 671 | return ``(Exists %%lm) 672 | | [app (sym "List") [], bd] := pexpr_of_mmexpr env bd 673 | | [app (sym "List") (h::t), bd] := pexpr_of_mmexpr env (app (sym "Exists") [h, app (sym "Exists") [app (sym "List") t, bd]]) 674 | | _ := failed 675 | end⟩ 676 | 677 | @[sym_to_pexpr] 678 | meta def type_to_pexpr : sym_trans_pexpr_rule := 679 | ⟨"Type", ```(Type)⟩ 680 | 681 | @[sym_to_pexpr] 682 | meta def prop_to_pexpr : sym_trans_pexpr_rule := 683 | ⟨"Prop", ```(Prop)⟩ 684 | 685 | 686 | @[sym_to_pexpr] 687 | meta def inter_to_pexpr : sym_trans_pexpr_rule := 688 | ⟨"SetInter", ```(has_inter.inter)⟩ 689 | 690 | @[sym_to_pexpr] 691 | meta def union_to_pexpr : sym_trans_pexpr_rule := 692 | ⟨"SetUnion", ```(has_union.union)⟩ 693 | 694 | @[sym_to_pexpr] 695 | meta def compl_to_pexpr : sym_trans_pexpr_rule := 696 | ⟨"SetCompl", ```(has_compl.compl)⟩ 697 | 698 | @[sym_to_pexpr] 699 | meta def empty_to_pexpr : sym_trans_pexpr_rule := 700 | ⟨"EmptySet", ```(∅)⟩ 701 | 702 | 703 | @[sym_to_pexpr] 704 | meta def rat_to_pexpr : sym_trans_pexpr_rule := 705 | ⟨"Rational", ```(has_div.div)⟩ 706 | 707 | @[sym_to_pexpr] 708 | meta def eq_to_pexpr : sym_trans_pexpr_rule := 709 | ⟨"Equal", ```(eq)⟩ 710 | 711 | @[sym_to_expr] 712 | meta def true_to_expr : sym_trans_expr_rule := 713 | ⟨"True", `(true)⟩ 714 | 715 | @[sym_to_expr] 716 | meta def false_to_expr : sym_trans_expr_rule := 717 | ⟨"False", `(false)⟩ 718 | 719 | 720 | @[sym_to_pexpr] 721 | meta def less_to_pexpr : mathematica.sym_trans_pexpr_rule := 722 | ⟨"Less", ``(has_lt.lt)⟩ 723 | 724 | @[sym_to_pexpr] 725 | meta def greater_to_pexpr : mathematica.sym_trans_pexpr_rule := 726 | ⟨"Greater", ``(gt)⟩ 727 | 728 | @[sym_to_pexpr] 729 | meta def lesseq_to_pexpr : mathematica.sym_trans_pexpr_rule := 730 | ⟨"LessEqual", ``(has_le.le)⟩ 731 | 732 | @[sym_to_pexpr] 733 | meta def greatereq_to_pexpr : mathematica.sym_trans_pexpr_rule := 734 | ⟨"GreaterEqual", ``(ge)⟩ 735 | 736 | end transl_expr_instances 737 | end mathematica 738 | 739 | -- user-facing tactics 740 | namespace tactic 741 | namespace mathematica 742 | open _root_.mathematica 743 | 744 | meta def mk_get_cmd (path : string) : tactic string := 745 | do s ← extras_path, 746 | -- return $ "Get[\"" ++ path ++ "\",Path->{DirectoryFormat[\""++ s ++"\"]}];" 747 | return $ "Get[\"" ++ path ++ "\",Path->{DirectoryFormat[\""++ s ++"\"]}];" 748 | 749 | /-- 750 | load_file path will load the file found at path into Mathematica. 751 | The declarations will persist until the kernel is restarted. 752 | -/ 753 | meta def load_file (path : string) : tactic unit := 754 | do s ← mk_get_cmd path, 755 | execute_global s >> return () 756 | 757 | /-- 758 | run_command_on cmd e reflects e into Mathematica syntax, applies cmd to this reflection, 759 | evaluates this in Mathematica, and attempts to translate the result to a pexpr. 760 | -/ 761 | meta def run_command_on (cmd : string → string) (e : expr) : tactic pexpr := 762 | do rval ← execute_and_eval $ cmd $ form_of_expr e, 763 | --rval' ← eval_expr mmexpr rval, 764 | pexpr_of_mmexpr trans_env.empty rval 765 | 766 | /-- 767 | run_command_on_using cmd e path reflects e into Mathematica syntax, applies cmd to this reflection, 768 | evaluates this in Mathematica after importing the file at path, and attempts to translate the result to a pexpr. 769 | -/ 770 | meta def run_command_on_using (cmd : string → string) (e : expr) (path : string) : tactic pexpr := 771 | do p ← escape_slash <$> mk_get_cmd path, 772 | run_command_on (λ s, p ++ cmd s) e 773 | 774 | meta def run_command_on_2 (cmd : string → string → string) (e1 e2 : expr) : tactic pexpr := 775 | do rval ← execute_and_eval $ cmd (form_of_expr e1) (form_of_expr e2), 776 | --rval' ← eval_expr mmexpr rval, 777 | pexpr_of_mmexpr trans_env.empty rval 778 | 779 | /-- 780 | run_command_on_2_using cmd e1 e2 reflects e1 and e2 into Mathematica syntax, 781 | applies cmd to these reflections, evaluates this in Mathematica after importing the file at path, 782 | and attempts to translate the result to a pexpr. 783 | -/ 784 | meta def run_command_on_2_using (cmd : string → string → string) (e1 e2 : expr) (path : string) : 785 | tactic pexpr := 786 | do p ← escape_slash <$> mk_get_cmd path, 787 | run_command_on_2 (λ s1 s2, p ++ cmd s1 s2) e1 e2 788 | 789 | private def sep_string : list string → string 790 | | [] := "" 791 | | [s] := s 792 | | (h::t) := h ++ ", " ++ sep_string t 793 | 794 | /-- 795 | run_command_on_list cmd l reflects each element of l into Mathematica syntax, 796 | applies cmd to a Mathematica list of these reflections, 797 | evaluates this in Mathematica, and attempts to translate the result to a pexpr. 798 | -/ 799 | meta def run_command_on_list (cmd : string → string) (l : list expr) : tactic pexpr := 800 | let lvs := "{" ++ (sep_string $ l.map form_of_expr) ++ "}" in 801 | do rval ← execute_and_eval $ cmd lvs, 802 | --rval' ← eval_expr mmexpr rval, 803 | pexpr_of_mmexpr trans_env.empty rval 804 | 805 | 806 | meta def run_command_on_list_using (cmd : string → string) (l : list expr) (path : string) : tactic pexpr := 807 | let lvs := "{" ++ (sep_string $ l.map form_of_expr) ++ "}" in 808 | do p ← mk_get_cmd path, 809 | rval ← execute_and_eval $ p ++ cmd lvs, 810 | --rval' ← eval_expr mmexpr rval, 811 | pexpr_of_mmexpr trans_env.empty rval 812 | 813 | end mathematica 814 | end tactic 815 | -------------------------------------------------------------------------------- /src/mathematica_parser.lean: -------------------------------------------------------------------------------- 1 | import data.buffer.parser system.io 2 | open parser 3 | --namespace mathematica 4 | 5 | meta def htfi : has_to_format ℤ := ⟨λ z, int.rec_on z (λ k, ↑k) (λ k, "-"++↑(k+1))⟩ 6 | local attribute [instance] htfi 7 | 8 | 9 | structure mfloat := 10 | (sign : ℕ) 11 | (mantisa : ℕ) 12 | (exponent : ℕ) 13 | 14 | local notation `float` := mfloat 15 | 16 | meta instance : has_to_format float := 17 | ⟨λ f, to_fmt "(" ++ to_fmt f.sign ++ to_fmt ", " ++ 18 | to_fmt f.mantisa ++ ", " ++ to_fmt f.exponent ++ to_fmt ")"⟩ 19 | 20 | meta instance : has_reflect float | ⟨s, m, e⟩ := 21 | ((`(λ s' m' e', mfloat.mk s' m' e').subst (nat.reflect s)).subst (nat.reflect m)).subst (nat.reflect e) 22 | 23 | /-- 24 | The type mmexpr reflects Mathematica expression syntax. 25 | -/ 26 | inductive mmexpr : Type 27 | | sym : string → mmexpr 28 | | mstr : string → mmexpr 29 | | mint : int → mmexpr 30 | | app : mmexpr → list mmexpr → mmexpr 31 | | mreal : float → mmexpr 32 | 33 | 34 | meta def mmexpr_list_to_format (f : mmexpr → format) : list mmexpr → format 35 | | [] := to_fmt "" 36 | | [h] := f h 37 | | (h :: t) := f h ++ ", " ++ mmexpr_list_to_format t 38 | 39 | open mmexpr 40 | meta def mmexpr_to_format : mmexpr → format 41 | | (sym s) := to_fmt s 42 | | (mstr s) := to_fmt "\"" ++ to_fmt s ++ "\"" 43 | | (mint i) := to_fmt i 44 | | (app e1 ls) := mmexpr_to_format e1 ++ to_fmt "[" ++ mmexpr_list_to_format mmexpr_to_format ls ++ to_fmt "]" 45 | | (mreal r) := to_fmt r 46 | 47 | 48 | meta instance : has_to_format mmexpr := ⟨mmexpr_to_format⟩ 49 | 50 | def nat_of_char : char → ℕ 51 | | '0' := 0 52 | | '1' := 1 53 | | '2' := 2 54 | | '3' := 3 55 | | '4' := 4 56 | | '5' := 5 57 | | '6' := 6 58 | | '7' := 7 59 | | '8' := 8 60 | | '9' := 9 61 | | _ := 0 62 | 63 | def nat_of_string_aux : ℕ → ℕ → list char → ℕ 64 | | weight acc [] := acc 65 | | weight acc (h::t) := nat_of_string_aux (weight*10) (weight * (nat_of_char h) + acc) t 66 | 67 | def nat_of_string (s : string) : nat := 68 | nat_of_string_aux 1 0 s.to_list.reverse 69 | 70 | def parse_is_neg : parser bool := 71 | (ch '-' >> return tt) <|> return ff 72 | 73 | def parse_int : parser mmexpr := 74 | do str "I[", 75 | is_neg ← parse_is_neg, 76 | n ← (nat_of_string ∘ list.as_string) <$> many (sat char.is_alphanum), 77 | ch ']', 78 | return $ mmexpr.mint (if is_neg then -n else n) 79 | 80 | def parse_string : parser mmexpr := 81 | do str "T[\"", 82 | s ← list.as_string <$> many (sat ((≠) '\"')), 83 | ch '\"', ch ']', 84 | return $ mmexpr.mstr s 85 | 86 | def parse_symbol : parser mmexpr := 87 | do str "Y[", 88 | s ← list.as_string <$> many (sat ((≠) ']')), 89 | ch ']', 90 | return $ mmexpr.sym s 91 | 92 | def parse_app_aux (parse_expr : parser mmexpr) : parser mmexpr := 93 | do str "A", 94 | hd ← parse_expr, 95 | ch '[', 96 | args ← sep_by (ch ',') parse_expr, 97 | ch ']', 98 | return $ mmexpr.app hd args 99 | 100 | def parse_mmexpr_aux (p : parser mmexpr) : parser mmexpr := 101 | parse_int <|> parse_string <|> parse_symbol <|> (parse_app_aux p) 102 | 103 | def parse_mmexpr : parser mmexpr := fix parse_mmexpr_aux 104 | 105 | private def make_monospaced : char → char 106 | | '\n' := ' ' 107 | | '\t' := ' ' 108 | | '\x0d' := ' ' 109 | | c := c 110 | 111 | def mk_mono_cb (s : char_buffer) : char_buffer := 112 | s.map make_monospaced 113 | 114 | def buffer.back {α} [inhabited α] (b : buffer α) : α := 115 | b.read' (b.size-1) 116 | 117 | meta def strip_trailing_whitespace_cb : char_buffer → char_buffer := λ s, 118 | if s.back = '\n' ∨ s.back = ' ' then strip_trailing_whitespace_cb s.pop_back else s 119 | 120 | def escape_quotes_cb (s : char_buffer) : char_buffer := 121 | s.foldl buffer.nil (λ c s', if c = '\"' then s' ++ "\\\"".to_char_buffer else s'.push_back c) 122 | 123 | def escape_term_buffer_cb (s : char_buffer) : char_buffer := 124 | s.foldl buffer.nil (λ c s', if c = '&' then s' ++ "&&".to_char_buffer else s'.push_back c) 125 | 126 | def quote_string_cb (s : char_buffer) : char_buffer := 127 | "\'".to_char_buffer ++ s ++ "\'".to_char_buffer 128 | 129 | 130 | def mk_mono (s : string) : string := 131 | (s.to_list.map make_monospaced).as_string 132 | 133 | meta def strip_trailing_whitespace : string → string := λ s, 134 | if s.back = '\n' ∨ s.back = ' ' then strip_trailing_whitespace s.pop_back else s 135 | 136 | def strip_newline : string → string := λ s, 137 | if s.back = '\n' then s.pop_back else s 138 | 139 | def escape_quotes (s : string) : string := 140 | s.fold "" (λ s' c, if c = '\"' then s' ++ "\\\"" else s'.str c) 141 | 142 | def escape_term (s : string) : string := 143 | s.fold "" (λ s' c, if c = '&' then s' ++ "&&" else s'.str c) 144 | 145 | def escape_slash (s : string) : string := 146 | s.fold "" (λ s' c, if c = '\\' then s' ++ "\\\\" else s'.str c) 147 | 148 | def quote_string (s : string) : string := 149 | "\'" ++ s ++ "\'" 150 | 151 | meta def parse_mmexpr_tac (s : char_buffer) : tactic mmexpr := 152 | match parser.run parse_mmexpr ((strip_trailing_whitespace_cb ∘ mk_mono_cb) s) with 153 | | sum.inr mme := return mme 154 | | sum.inl error := tactic.fail error 155 | end 156 | 157 | def parse_name : parser (list string) := 158 | do l ← sep_by (ch '.') (many $ sat ((≠) '.')), 159 | return $ (l.map list.as_string).reverse 160 | 161 | def mk_name_using : list string → name 162 | | [] := name.anonymous 163 | | (s :: l) := mk_str_name (mk_name_using l) s 164 | 165 | meta def parse_name_tac (s : string) : tactic name := 166 | match parser.run_string parse_name s with 167 | | sum.inr ls := return $ mk_name_using ls 168 | | sum.inl error := tactic.fail error 169 | end 170 | 171 | /-meta def parse_mmexpr_tac (s : char_buffer) : tactic mmexpr := 172 | (do sum.inr mme ← return $ parser.run parse_mmexpr ((strip_trailing_whitespace_cb ∘ mk_mono_cb) s), 173 | return mme) 174 | -/ 175 | namespace mathematica 176 | 177 | section 178 | 179 | def write_file (fn : string) (cnts : string) (mode := io.mode.write) : io unit := do 180 | h ← io.mk_file_handle fn io.mode.write, 181 | io.fs.write h cnts.to_char_buffer, 182 | io.fs.close h 183 | 184 | 185 | def exists_file (f : string) : io bool := do 186 | ch ← io.proc.spawn { cmd := "test", args := ["-f", f] }, 187 | ev ← io.proc.wait ch, 188 | return $ ev = 0 189 | 190 | meta def new_text_file : string → ℕ → io nat | base n := 191 | do b ← exists_file (base ++ to_string n ++ ".txt"), 192 | if b then new_text_file base (n+1) 193 | else return n 194 | 195 | end 196 | 197 | meta def temp_file_name (base : string) : tactic string := 198 | do n ← tactic.unsafe_run_io $ new_text_file base 0, 199 | return $ base ++ to_string n ++ ".txt" 200 | end mathematica 201 | 202 | def io.buffer_cmd (args : io.process.spawn_args) : io char_buffer := 203 | do child ← io.proc.spawn { args with stdout := io.process.stdio.piped }, 204 | buf ← io.fs.read_to_end child.stdout, 205 | exitv ← io.proc.wait child, 206 | when (exitv ≠ 0) $ io.fail $ "process exited with status " ++ to_string exitv, 207 | return buf 208 | -------------------------------------------------------------------------------- /src/server2.m: -------------------------------------------------------------------------------- 1 | (* ::Package:: *) 2 | 3 | 4 | $ContextPath = Append[$ContextPath,"MyGlobalContext`"]; 5 | $Context = "MyGlobalContext`"; 6 | cctr = 0; 7 | mgc = "MyGlobalContext`"; 8 | ClearAll["Global`*"]; 9 | 10 | << "lean_form.m" 11 | 12 | WindowsDirQ[s_String] := StringTake[s, 1] != "/"; 13 | ToWindowsDir[s_String] := 14 | If[WindowsDirQ[s], s, 15 | With[{t = StringTake[s, {2}]}, 16 | FileNameJoin[{t <> ":" <> StringDrop[s, 2]}]]]; 17 | DirectoryFormat[s_String] := 18 | If[WindowsDirQ[Directory[]], ToWindowsDir[s], s] 19 | 20 | s = SocketOpen[10000] 21 | 22 | OutputFormat[i_Integer] := "I[" <> ToString[i] <> "]" 23 | OutputFormat[s_String] := "T[\"" <> s <> "\"]" 24 | OutputFormat[s_Symbol] := "Y[" <> ToString[s] <> "]" 25 | OutputFormat[h_[args___]] := 26 | "A" <> OutputFormat[h] <> "[" <> 27 | StringRiffle[Map[OutputFormat, List[args]], ","] <> "]" 28 | 29 | resp := "" 30 | 31 | AccumulateResponse[query_] := 32 | resp = resp <> ToString[query]; Print[resp] 33 | 34 | ResponseCompleteQ[] := StringTake[resp,{-3,-2}] == "&!" 35 | 36 | CreateResponse[] := 37 | Module[{o, g=ToExpression[StringTake[resp,-1]], xct}, 38 | xct = If[g==0,"LeanLinkCtx`",mgc]; 39 | $Context = xct; 40 | o = ToExpression[StringDrop[StringReplace[resp,"&&"->"&"],-3]] // OutputFormat; 41 | $Context = mgc; 42 | ClearAll["Global`*"]; 43 | ClearAll["LeanLinkCtx`*"]; 44 | resp = ""; 45 | StringToByteArray[o]] 46 | 47 | SocketListen[s, 48 | (AccumulateResponse[#["Data"]]; 49 | If[ResponseCompleteQ[], 50 | Print[resp]; With[{out=CreateResponse[]}, Print[out]; 51 | WriteString[#["SourceSocket"], ToString[Length[out]] <> " "]; BinaryWrite[#["SourceSocket"], out]], True])&]; 52 | 53 | --------------------------------------------------------------------------------