├── .gitignore ├── LICENSE.md ├── Makefile ├── Readme.md ├── bin ├── jbuild └── main.ml ├── example ├── config.ml └── myLua.ml ├── functoria-lua.opam ├── lib ├── Functoria_lua.ml ├── Functoria_lua.mli └── jbuild └── pkg └── pkg.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | *.install 3 | 4 | #*# 5 | .merlin 6 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Permission to use, copy, modify, and distribute this software for any 2 | purpose with or without fee is hereby granted, provided that the above 3 | copyright notice and this permission notice appear in all copies. 4 | 5 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 6 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 7 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 8 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 9 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 10 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 11 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 12 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all clean doc 2 | 3 | all: 4 | jbuilder build --dev 5 | 6 | clean: 7 | jbuilder clean 8 | 9 | doc: 10 | jbuilder build --dev @doc 11 | 12 | REPO=../opam-repository 13 | PACKAGES=$(REPO)/packages 14 | 15 | # until we have https://github.com/ocaml/opam-publish/issues/38 16 | pkg-%: 17 | topkg opam pkg -n $* 18 | mkdir -p $(PACKAGES)/$* 19 | cp -r _build/$*.* $(PACKAGES)/$*/ 20 | rm -f $(PACKAGES)/$*/$*.opam 21 | cd $(PACKAGES) && git add $* 22 | 23 | PKGS=$(basename $(wildcard *.opam)) 24 | opam-pkg: 25 | $(MAKE) $(PKGS:%=pkg-%) 26 | -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | Functoria-lua 2 | -------------- 3 | 4 | [Lua-ml](https://github.com/lindig/lua-ml) is a modular Lua interpreter written 5 | in OCaml. "Modular" here means that every part of the interpreter is expressed 6 | as a functor parametrized over its dependencies. It allows users to 7 | add new primitives and replace parts as desired. 8 | 9 | [Functoria](https://github.com/mirage/functoria) is a library to create DSL 10 | manipulating such functor-based libraries. It was originally created for 11 | [mirageOS](https://mirage.io/) (See [this blog post](https://mirage.io/blog/introducing-functoria) for more details). 12 | 13 | functoria-lua uses functoria to define a set of combinators to build 14 | customized lua intepretors with lua-ml. See the [example](example) directory. 15 | 16 | ## Install 17 | 18 | You will need the following things: 19 | - A version of functoria that support projections: https://github.com/mirage/functoria/pull/150 20 | - An opamified version of lua-ml: https://github.com/lindig/lua-ml/pull/3 21 | 22 | Then you can pin this repository: 23 | 24 | ``` 25 | opam pin add functoria-lua "https://github.com/Drup/functoria-lua.git" 26 | ``` 27 | 28 | To try out the example: 29 | 30 | ``` 31 | cd example/ 32 | functoria-lua config 33 | opam install --deps . 34 | functoria-lua build 35 | ``` 36 | 37 | --------- 38 | 39 | ![Graph of the example](https://i.imgur.com/HmPyofZ.png) 40 | -------------------------------------------------------------------------------- /bin/jbuild: -------------------------------------------------------------------------------- 1 | (jbuild_version 1) 2 | 3 | (executable 4 | ((name main) 5 | (public_name functoria-lua) 6 | (package functoria-lua) 7 | (libraries (functoria-lua)))) 8 | -------------------------------------------------------------------------------- /bin/main.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2013 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | let () = Functoria_lua.run () 18 | -------------------------------------------------------------------------------- /example/config.ml: -------------------------------------------------------------------------------- 1 | open Functoria_lua 2 | 3 | (** User defined types *) 4 | let char : char usertype impl = new_type "MyLua.LuaChar" 5 | type pair 6 | let pair : pair usertype impl = new_type "MyLua.Pair" 7 | 8 | (** Semantics for the user defined types *) 9 | let makelib = impl @@ object 10 | inherit [_]foreign "MyLua.MakeLib" (view @-> view @-> usercode) 11 | method connect _ _ _ = "()" 12 | end 13 | 14 | (** Running application *) 15 | let files = 16 | let file = Key.Arg.conv ~conv:Cmdliner.Arg.file ~runtime_conv:"Cmdliner.Arg.file" 17 | ~serialize:Format.pp_print_string 18 | in 19 | let doc = "Lua files to be executed by the interpreter" in 20 | let doc = Key.Arg.info ~docv:"FILES" ~doc ["f";"files"] in 21 | let key = Key.Arg.opt ~stage:`Run Key.Arg.(list file) [] doc in 22 | Key.create "files" key 23 | 24 | let dump = 25 | let doc = "Dump the state after execution" in 26 | let doc = Key.Arg.info ~docv:"DUMP" ~doc ["d";"dump"] in 27 | let key = Key.Arg.flag ~stage:`Both doc in 28 | Key.create "dumpstate" key 29 | 30 | let runinterp = 31 | foreign ~keys:Key.[abstract files; abstract dump] "MyLua.Run" (interp @-> job) 32 | 33 | (** Functor spaghetti *) 34 | 35 | let t = t3 () $ char $ pair $ iolib_type 36 | let char_t = tv1() $ t 37 | let pair_t = tv2() $ t 38 | let iolib_t = tv3() $ t 39 | 40 | let w = withtype () $ as_type t 41 | let c = 42 | c5() 43 | $ (iolib() $ iolib_t) 44 | $ (camllib() $ iolib_t) 45 | $ (w $ strlib) 46 | $ (w $ mathlib) 47 | $ (makelib $ char_t $ pair_t) 48 | 49 | let i = 50 | mk_interp $ mk_parser $ (mk_eval() $ as_type t $ c) 51 | 52 | 53 | let () = register "toplua" [runinterp $ i] 54 | -------------------------------------------------------------------------------- /example/myLua.ml: -------------------------------------------------------------------------------- 1 | module LuaChar = struct 2 | type 'a t = char 3 | let tname = "char" 4 | let eq _ = fun x y -> x = y 5 | let to_string = fun _ c -> String.make 1 c 6 | end 7 | 8 | module Pair = struct 9 | type 'a t = 'a * 'a 10 | let tname = "pair" 11 | let eq _ = fun x y -> x = y 12 | let to_string = fun f (x,y) -> Printf.sprintf "(%s,%s)" (f x) (f y) 13 | let mk x y = (x,y) 14 | let fst = fst 15 | let snd = snd 16 | end 17 | 18 | module MakeLib 19 | (CharV: Lua.Lib.TYPEVIEW with type 'a t = 'a LuaChar.t) 20 | (PairV: Lua.Lib.TYPEVIEW with type 'a t = 'a Pair.t 21 | and type 'a combined = 'a CharV.combined) 22 | : Lua.Lib.USERCODE with type 'a userdata' = 'a CharV.combined = struct 23 | 24 | type 'a userdata' = 'a PairV.combined 25 | module M (C: Lua.Lib.CORE with type 'a V.userdata' = 'a userdata') = struct 26 | module V = C.V 27 | let ( **-> ) = V.( **-> ) 28 | let ( **->> ) x y = x **-> V.result y 29 | module Map = struct 30 | let pair = PairV.makemap V.userdata V.projection 31 | let char = CharV.makemap V.userdata V.projection 32 | end 33 | 34 | let init g = 35 | 36 | C.register_module "Pair" 37 | [ "mk", V.efunc (V.value **-> V.value **->> Map.pair) Pair.mk 38 | ; "fst",V.efunc (Map.pair **->> V.value) Pair.fst 39 | ; "snd",V.efunc (Map.pair **->> V.value) Pair.snd 40 | ] g; 41 | 42 | C.register_module "Char" 43 | [ "mk", V.efunc (V.string **->> Map.char) 44 | (function 45 | | "" -> C.error "Char.mk: empty string" 46 | | s -> s.[0] 47 | ) 48 | ] g; 49 | 50 | C.register_module "Example" 51 | ["argv", (V.list V.string).V.embed (Array.to_list Sys.argv); 52 | "getenv", V.efunc (V.string **->> V.string) Sys.getenv; 53 | ] g; 54 | 55 | 56 | end (* M *) 57 | end (* MakeLib *) 58 | 59 | module Run (I : Lua.INTERP) = struct 60 | module V = I.Value 61 | let state = I.mk () 62 | let showresults = 63 | let rec loop n = function 64 | | h :: t -> print_string "Result "; print_int n; print_string " = "; 65 | print_endline (V.to_string h); loop (n+1) t 66 | | [] -> () 67 | in loop 1 68 | let run infile = ignore (I.dofile state infile) 69 | let run_interactive infile = 70 | let rec loop n pfx = 71 | let line = input_line infile in 72 | if String.length line > 0 && String.get line (String.length line - 1) = '\\' then 73 | loop n (pfx ^ String.sub line 0 (String.length line - 1) ^ "\n") 74 | else 75 | begin 76 | ignore (I.dostring state (pfx ^ line ^ "\n")); 77 | flush stdout; flush stderr; 78 | loop (n+1) "" 79 | end 80 | in try loop 1 "" with End_of_file -> () 81 | 82 | let start () = 83 | begin match Key_gen.files () with 84 | | [] -> run_interactive stdin 85 | | l -> List.iter run l 86 | end ; 87 | if Key_gen.dumpstate () then begin 88 | print_endline "final state: "; 89 | Luahash.iter (fun k v -> print_string " "; 90 | print_string (V.to_string k); print_string " |-> "; 91 | print_endline (V.to_string v)) state.V.globals 92 | end 93 | end 94 | 95 | 96 | -------------------------------------------------------------------------------- /functoria-lua.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | maintainer: ["drupyog@zoho.com"] 3 | authors: ["Gabriel Radanne"] 4 | homepage: "https://github.com/Drup/functoria-lua" 5 | bug-reports: "https://github.com/Drup/functoria-lua/issues/" 6 | dev-repo: "https://github.com/Drup/functoria-lua.git" 7 | tags: ["functor"] 8 | 9 | build: [ 10 | ["jbuilder" "subst"]{pinned} 11 | ["jbuilder" "build" "-p" name "-j" jobs] 12 | ] 13 | 14 | depends: [ 15 | "jbuilder" {build & >= "1.0+beta10"} 16 | "functoria" {>= "2.2.0"} 17 | ] 18 | available: [ocaml-version >= "4.04.2"] 19 | -------------------------------------------------------------------------------- /lib/Functoria_lua.ml: -------------------------------------------------------------------------------- 1 | open Rresult 2 | open Astring 3 | 4 | module Key = Functoria_key 5 | module Name = Functoria_app.Name 6 | module Codegen = Functoria_app.Codegen 7 | include Functoria 8 | 9 | 10 | let tool_name = "functoria-lua" 11 | 12 | let src = Logs.Src.create tool_name ~doc:"functoria-lua cli tool" 13 | module Log = (val Logs.src_log src : Logs.LOG) 14 | 15 | (** Devices **) 16 | 17 | class base = object 18 | method packages: package list Key.value = Key.pure [] 19 | method keys: Key.t list = [] 20 | method connect (_:Info.t) (_:string) (_l: string list) = "()" 21 | method configure (_: Info.t): (unit, R.msg) R.t = R.ok () 22 | method build (_: Info.t): (unit, R.msg) R.t = R.ok () 23 | method clean (_: Info.t): (unit, R.msg) R.t = R.ok () 24 | method deps: abstract_impl list = [] 25 | end 26 | 27 | type +'a usertype = USERTYPE 28 | let usertype = Type USERTYPE 29 | 30 | class ['ty] new_type 31 | ?(packages=[]) ?(keys=[]) ?(deps=[]) module_name 32 | : ['ty usertype] configurable 33 | = 34 | let name = Name.create module_name ~prefix:"type" in 35 | object 36 | method ty : 'ty usertype typ = usertype 37 | method name = name 38 | method module_name = module_name 39 | method keys = keys 40 | method packages = Key.pure packages 41 | method connect (_:Info.t) (_:string) (_l: string list) = "()" 42 | method clean _ = R.ok () 43 | method configure _ = R.ok () 44 | method build _ = R.ok () 45 | method deps = deps 46 | end 47 | let new_type ?packages ?keys ?deps module_name = 48 | impl (new new_type ?packages ?keys ?deps module_name) 49 | 50 | 51 | (* Luavalue.S *) 52 | type _ luavalue = VALUE 53 | let value = Type VALUE 54 | let mk_value () = impl @@ object 55 | inherit base 56 | method ty = usertype @-> value 57 | method name = "ast" 58 | method module_name = "Luavalue.Make" 59 | end 60 | 61 | (* Luaast.S *) 62 | type ast = AST 63 | let ast = Type AST 64 | let mk_ast () = impl @@ object 65 | inherit base 66 | method ty = value @-> ast 67 | method name = "ast" 68 | method module_name = "Luaast.Make" 69 | end 70 | 71 | (* Luaparser.S *) 72 | type parser = PARSER 73 | let parser = Type PARSER 74 | let maker = ast @-> parser 75 | 76 | let mk_parser = impl @@ object 77 | inherit base 78 | method ty = maker 79 | method name = "parser" 80 | method module_name = "Luaparser.MakeStandard" 81 | end 82 | 83 | (* Lualib.BARECODE *) 84 | type barecode = BARECODE 85 | let barecode = Type BARECODE 86 | 87 | let bc n mn = impl @@ object 88 | inherit base 89 | method ty = barecode 90 | method name = n 91 | method module_name = mn 92 | end 93 | 94 | let mathlib = bc "mathlib" "Luamathlib.M" 95 | let strlib = bc "strlib" "Luastrlib.M" 96 | 97 | (* Lualib.USERCODE *) 98 | type +'a usercode = USERCODE 99 | let usercode = Type USERCODE 100 | 101 | let c2 () = impl @@ object 102 | inherit base 103 | method ty = usercode @-> usercode @-> usercode 104 | method name = "combineC2" 105 | method module_name = "Lua.Lib.Combine.C2" 106 | end 107 | let c3 () = impl @@ object 108 | inherit base 109 | method ty 110 | = usercode @-> usercode @-> usercode @-> usercode 111 | method name = "combineC3" 112 | method module_name = "Lua.Lib.Combine.C3" 113 | end 114 | let c4 () = impl @@ object 115 | inherit base 116 | method ty 117 | = usercode @-> usercode @-> usercode @-> usercode @-> usercode 118 | method name = "combineC4" 119 | method module_name = "Lua.Lib.Combine.C4" 120 | end 121 | let c5 () = impl @@ object 122 | inherit base 123 | method ty 124 | = usercode @-> usercode @-> usercode @-> usercode @-> usercode @-> usercode 125 | method name = "combineC5" 126 | method module_name = "Lua.Lib.Combine.C5" 127 | end 128 | 129 | (* Types *) 130 | 131 | type +'a combined = 'a usertype 132 | let combined = usertype 133 | 134 | let as_type x = x 135 | 136 | type (+'a, +'b) view = VIEW 137 | let view = Type VIEW 138 | 139 | let withtype () = impl @@ object 140 | inherit base 141 | method ty = usertype @-> barecode @-> usercode 142 | method name = "withtype" 143 | method module_name = "Lua.Lib.WithType" 144 | end 145 | 146 | let takeview i = 147 | proj (combined @-> view) ("TV"^string_of_int i) 148 | let tv1 () : ((< tv1 : 'a ; .. > as 'c) combined -> ('a, 'c) view) impl = takeview 1 149 | let tv2 () : ((< tv2 : 'a ; .. > as 'c) combined -> ('a, 'c) view) impl = takeview 2 150 | let tv3 () : ((< tv3 : 'a ; .. > as 'c) combined -> ('a, 'c) view) impl = takeview 3 151 | let tv4 () : ((< tv4 : 'a ; .. > as 'c) combined -> ('a, 'c) view) impl = takeview 4 152 | 153 | let t2 () = impl @@ object 154 | inherit base 155 | method ty = usertype @-> usertype @-> combined 156 | method name = "combine2" 157 | method module_name = "Lua.Lib.Combine.T2" 158 | end 159 | let t3 () = impl @@ object 160 | inherit base 161 | method ty = usertype @-> usertype @-> usertype @-> combined 162 | method name = "combine3" 163 | method module_name = "Lua.Lib.Combine.T3" 164 | end 165 | let t4 () = impl @@ object 166 | inherit base 167 | method ty = usertype @-> usertype @-> usertype @-> usertype @-> combined 168 | method name = "combine4" 169 | method module_name = "Lua.Lib.Combine.T4" 170 | end 171 | 172 | (* Luaiolib *) 173 | type iolib 174 | let iolib_type : iolib usertype impl = new_type "Luaiolib.T" 175 | let iolib () = impl @@ object 176 | inherit base 177 | method ty = view @-> usercode 178 | method name = "iolib" 179 | method module_name = "Luaiolib.Make" 180 | end 181 | 182 | (* Luacamllib *) 183 | let camllib () = impl @@ object 184 | inherit base 185 | method ty = view @-> usercode 186 | method name = "camllib" 187 | method module_name = "Luacamllib.Make" 188 | end 189 | 190 | (* Lua.MakeEval *) 191 | type eval = EVAL 192 | let eval = Type EVAL 193 | let mk_eval () = impl @@ object 194 | inherit base 195 | method ty = usertype @-> usercode @-> eval 196 | method name = "eval" 197 | method module_name = "Lua.MakeEval" 198 | end 199 | 200 | type interp = INTERP 201 | let interp = Type INTERP 202 | let mk_interp = impl @@ object 203 | inherit base 204 | method ty = maker @-> eval @-> interp 205 | method name = "interp" 206 | method module_name = "Lua.MakeInterp" 207 | end 208 | 209 | let runlua = impl @@ object 210 | inherit base 211 | method ty = interp @-> job 212 | method name = "run" 213 | method module_name = "Lua.Run" 214 | method! connect _ _ _ = "fun () -> ()" 215 | end 216 | 217 | (** Tool-related functions *) 218 | 219 | let with_output ?mode f k err = 220 | match Bos.OS.File.with_oc ?mode f k () with 221 | | Ok b -> b 222 | | Error _ -> R.error_msg ("couldn't open output channel for " ^ err) 223 | 224 | (** Makefile **) 225 | 226 | let configure_makefile ~app_name info = 227 | let name = Info.name info in 228 | let open Codegen in 229 | let file = Fpath.(v "Makefile") in 230 | with_output file (fun oc () -> 231 | let fmt = Format.formatter_of_out_channel oc in 232 | append fmt {| 233 | # %s 234 | -include Makefile.user"; 235 | OPAM = opam 236 | BIN = %s 237 | DEPEXT ?= opam depext --yes --update %s 238 | 239 | .PHONY: all depend depends clean build 240 | all:: build 241 | 242 | depend depends:: 243 | $(OPAM) pin add --no-action --yes %s . 244 | $(DEPEXT) 245 | $(OPAM) install --yes --deps-only %s 246 | $(OPAM) pin remove --no-action %s 247 | 248 | build:: 249 | $(BIN) build 250 | 251 | clean:: 252 | $(BIN) clean 253 | |} 254 | (generated_header ()) name app_name app_name app_name app_name; 255 | R.ok ()) 256 | "Makefile" 257 | let clean_makefile () = Bos.OS.File.delete Fpath.(v "Makefile") 258 | 259 | (** Ocamlbuild *) 260 | 261 | let fn = Fpath.(v "myocamlbuild.ml") 262 | 263 | let configure_myocamlbuild () = 264 | Bos.OS.File.exists fn >>= function 265 | | true -> R.ok () 266 | | false -> Bos.OS.File.write fn "" 267 | 268 | (* we made it, so we should clean it up *) 269 | let clean_myocamlbuild () = 270 | match Bos.OS.Path.stat fn with 271 | | Ok stat when stat.Unix.st_size = 0 -> Bos.OS.File.delete fn 272 | | _ -> R.ok () 273 | 274 | (** OPAM file *) 275 | 276 | let configure_opam ~app_name info = 277 | let name = Info.name info in 278 | let open Codegen in 279 | let file = Fpath.(v name + "opam") in 280 | with_output file (fun oc () -> 281 | let fmt = Format.formatter_of_out_channel oc in 282 | append fmt "# %s" (generated_header ()); 283 | Info.opam ~name:app_name fmt info; 284 | append fmt "build: [ \"%s\" \"build\" ]" tool_name; 285 | append fmt "available: [ ocaml-version >= \"4.03.0\" ]"; 286 | R.ok ()) 287 | "opam file" 288 | 289 | let clean_opam ~name = Bos.OS.File.delete Fpath.(v name + "opam") 290 | 291 | 292 | let app_name name = 293 | String.concat ~sep:"-" ["lua" ; "ml" ; name] 294 | 295 | let configure i = 296 | let name = Info.name i in 297 | Log.info (fun m -> m "Configuring."); 298 | let app_name = app_name name in 299 | configure_myocamlbuild () >>= fun () -> 300 | configure_opam ~app_name i >>= fun () -> 301 | configure_makefile ~app_name i 302 | 303 | let clean i = 304 | let name = Info.name i in 305 | clean_myocamlbuild () >>= fun () -> 306 | clean_makefile () >>= fun () -> 307 | clean_opam ~name >>= fun () -> 308 | Bos.OS.File.delete Fpath.(v "main.native.o") >>= fun () -> 309 | Bos.OS.File.delete Fpath.(v "main.native") >>= fun () -> 310 | Bos.OS.File.delete Fpath.(v name) 311 | 312 | (** Compilation *) 313 | 314 | 315 | let terminal () = 316 | let dumb = try Sys.getenv "TERM" = "dumb" with Not_found -> true in 317 | let isatty = try Unix.(isatty (descr_of_out_channel Pervasives.stdout)) with 318 | | Unix.Unix_error _ -> false 319 | in 320 | not dumb && isatty 321 | 322 | let compile i = 323 | let libs = Info.libraries i in 324 | let tags = 325 | [ "warn(A-4-41-42-44)"; 326 | "debug"; 327 | "bin_annot"; 328 | "strict_sequence"; 329 | "principal"; 330 | "safe_string" ] @ 331 | (if terminal () then ["color(always)"] else []) 332 | in 333 | let concat = String.concat ~sep:"," in 334 | let cmd = Bos.Cmd.(v "ocamlbuild" % "-use-ocamlfind" % 335 | "-classic-display" % 336 | "-tags" % concat tags % 337 | "-pkgs" % concat libs % 338 | "main.native") 339 | in 340 | Log.info (fun m -> m "executing %a" Bos.Cmd.pp cmd); 341 | Bos.OS.Cmd.run cmd 342 | 343 | let link info = 344 | let name = Info.name info in 345 | Bos.OS.Cmd.run Bos.Cmd.(v "ln" % "-nfs" % "_build/main.native" % name) 346 | >>= fun () -> Ok name 347 | 348 | let build i = 349 | compile i >>= fun () -> 350 | link i >>| fun out -> 351 | Log.info (fun m -> m "Build succeeded: %s" out) 352 | 353 | module Project = struct 354 | let name = "functoria-lua" 355 | let version = "%%VERSION%%" 356 | let prelude = {| 357 | let (>>=) x f = f x 358 | let return x = x 359 | let run () = () 360 | |} 361 | 362 | (* The ocamlfind packages to use when compiling config.ml *) 363 | let packages = [package "functoria-lua"] 364 | 365 | (* The directories to ignore when compiling config.ml *) 366 | let ignore_dirs = [] 367 | 368 | let create jobs = impl @@ object 369 | inherit base_configurable 370 | method ty = job 371 | method name = tool_name 372 | method module_name = "Functoria_lua_runtime" 373 | method! keys = [ 374 | ] 375 | method! packages = 376 | let common = [ 377 | package "lua-ml"; 378 | package "functoria-runtime"; 379 | package ~build:true "ocamlfind" ; 380 | package ~build:true "ocamlbuild" ; 381 | ] in 382 | Key.pure common 383 | 384 | method! build = build 385 | method! configure = configure 386 | method! clean = clean 387 | method! connect _ _mod _names = "()" 388 | method! deps = List.map abstract jobs 389 | end 390 | 391 | end 392 | 393 | include Functoria_app.Make (Project) 394 | 395 | 396 | let register 397 | ?keys ?packages 398 | name jobs = 399 | let argv = Functoria_app.(keys sys_argv) in 400 | let init = [ argv ] in 401 | register ?keys ?packages ~init name jobs 402 | 403 | (* 404 | * Copyright (c) 2018 Gabriel Radanne 405 | * 406 | * Permission to use, copy, modify, and distribute this software for any 407 | * purpose with or without fee is hereby granted, provided that the above 408 | * copyright notice and this permission notice appear in all copies. 409 | * 410 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 411 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 412 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 413 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 414 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 415 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 416 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 417 | *) 418 | -------------------------------------------------------------------------------- /lib/Functoria_lua.mli: -------------------------------------------------------------------------------- 1 | [@@@warning "-32"] 2 | module Key = Functoria_key 3 | include Functoria_app.DSL 4 | 5 | type +'a usertype 6 | val usertype : 'a usertype typ 7 | val new_type : 8 | ?packages:package list -> 9 | ?keys:key list -> 10 | ?deps:abstract_impl list -> string -> 'a usertype impl 11 | 12 | type +'a luavalue 13 | val value : 'a luavalue typ 14 | val mk_value : unit -> ('a usertype -> 'a luavalue) impl 15 | 16 | type ast 17 | val ast : ast typ 18 | val mk_ast : unit -> ('a luavalue -> ast) impl 19 | 20 | type parser 21 | val parser : parser typ 22 | val maker : (ast -> parser) typ 23 | val mk_parser : (ast -> parser) impl 24 | 25 | type barecode 26 | val barecode : barecode typ 27 | val mathlib : barecode impl 28 | val strlib : barecode impl 29 | 30 | type +'a usercode 31 | val usercode : 'a usercode typ 32 | val c2 : unit -> ('a usercode -> 'a usercode -> 'a usercode) impl 33 | val c3 : unit -> ('a usercode -> 'a usercode -> 'a usercode -> 'a usercode) impl 34 | val c4 : unit -> ('a usercode -> 'a usercode -> 'a usercode -> 'a usercode -> 'a usercode) impl 35 | val c5 : unit -> ('a usercode -> 'a usercode -> 'a usercode -> 'a usercode -> 'a usercode -> 'a usercode) impl 36 | 37 | type +'a combined = private 'a usertype 38 | val combined : 'a combined typ 39 | 40 | val as_type : 'a combined impl -> 'a usertype impl 41 | 42 | type (+'a, +'b) view 43 | val view : ('a, 'b) view typ 44 | 45 | val withtype : unit -> ('a usertype -> barecode -> 'a usercode) impl 46 | 47 | val tv1 : unit -> ((< tv1 : 'a ; .. > as 'c) combined -> ('a, 'c) view) impl 48 | val tv2 : unit -> ((< tv2 : 'a ; .. > as 'c) combined -> ('a, 'c) view) impl 49 | val tv3 : unit -> ((< tv3 : 'a ; .. > as 'c) combined -> ('a, 'c) view) impl 50 | val tv4 : unit -> ((< tv4 : 'a ; .. > as 'c) combined -> ('a, 'c) view) impl 51 | 52 | val t2 : unit -> ('a usertype -> 'b usertype -> < tv1 : 'a; tv2 : 'b > combined) impl 53 | val t3 : unit -> 54 | ('a usertype -> 55 | 'b usertype -> 56 | 'c usertype -> < tv1 : 'a; tv2 : 'b; tv3 : 'c > combined) 57 | impl 58 | val t4 : unit -> 59 | ('a usertype -> 60 | 'b usertype -> 61 | 'c usertype -> 62 | 'd usertype -> 63 | < tv1 : 'a; tv2 : 'b; tv3 : 'c; tv4 : 'd > combined) 64 | impl 65 | 66 | type iolib 67 | val iolib_type : iolib usertype impl 68 | val iolib : unit -> ((iolib, 'a) view -> 'a usercode) impl 69 | val camllib : unit -> ((iolib, 'a) view -> 'a usercode) impl 70 | 71 | type eval 72 | val eval : eval typ 73 | val mk_eval : unit -> ('a usertype -> 'a usercode -> eval) impl 74 | 75 | type interp 76 | val interp : interp typ 77 | val mk_interp : ((ast -> parser) -> eval -> interp) impl 78 | 79 | val runlua : (interp -> job) impl 80 | 81 | val register: 82 | ?keys:Key.t list -> 83 | ?packages:Functoria.package list -> string -> job impl list -> unit 84 | 85 | (**/**) 86 | 87 | val run: unit -> unit 88 | 89 | 90 | (* 91 | * Copyright (c) 2018 Gabriel Radanne 92 | * 93 | * Permission to use, copy, modify, and distribute this software for any 94 | * purpose with or without fee is hereby granted, provided that the above 95 | * copyright notice and this permission notice appear in all copies. 96 | * 97 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 98 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 99 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 100 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 101 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 102 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 103 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 104 | *) 105 | -------------------------------------------------------------------------------- /lib/jbuild: -------------------------------------------------------------------------------- 1 | (jbuild_version 1) 2 | 3 | (library 4 | ((name functoria_lua) 5 | (public_name functoria-lua) 6 | (wrapped false) 7 | (libraries (functoria functoria.app)))) 8 | -------------------------------------------------------------------------------- /pkg/pkg.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "topkg-jbuilder.auto" 4 | --------------------------------------------------------------------------------