Permalink
Browse files

Add Ocaml toplevel

Ignore-this: 31734d0841792477486aa07474be67f9

darcs-hash:20110331205054-c8b6b-b3f1644daaa7ccb130bfe4cef02d2180b318a95b
  • Loading branch information...
1 parent 142de31 commit 21ce69e27c67349ea819cc92f52c45335eca24a7 jerome.vouillon committed Mar 31, 2011
Showing with 408 additions and 6 deletions.
  1. +1 −1 LICENSE
  2. +3 −1 Makefile
  3. +4 −1 compiler/Makefile
  4. +2 −2 compiler/parse.ml
  5. +1 −1 compiler/parse.mli
  6. +2 −0 toplevel/.depend
  7. +84 −0 toplevel/Makefile
  8. +12 −0 toplevel/index.html
  9. +137 −0 toplevel/toplevel.ml
  10. +162 −0 toplevel/toplevel_runtime.js
View
@@ -2,7 +2,7 @@ In the following, "the Compiler and Library" refers to all files
marked "Copyright CNRS Université Paris Diderot" in the following
directories and their sub-directories:
- compiler, lib, runtime, tools
+ compiler, lib, runtime, toplevel, tools
and "the Examples" refers to all files marked "Copyright CNRS
Université Paris Diderot" in directory "examples" and its
View
@@ -11,7 +11,9 @@ library:
$(MAKE) -C lib
runtime:
$(MAKE) -C runtime
-examples: compiler library
+toplevel: compiler library runtime
+ $(MAKE) -C toplevel
+examples: compiler library runtime
$(MAKE) -C examples
tests: compiler library
$(MAKE) -C tests
View
@@ -18,6 +18,9 @@ compile: $(COMPOBJS:cmx=cmo)
$(COMPILER): $(COMPOBJS)
ocamlfind ocamlopt -package findlib,str -linkpkg -o $@ $^
+compiler.cma: $(OBJS:cmx=cmo)
+ ocamlfind ocamlc -a -o $@ $^
+
%.cmx: %.ml
ocamlfind ocamlopt -package findlib,str -c $<
@@ -28,7 +31,7 @@ $(COMPILER): $(COMPOBJS)
ocamlfind ocamlc -package findlib,str -c $<
clean:
- rm -f *.cm[iox] *.o
+ rm -f *.cm[aiox] *.o
rm -f js_of_ocaml compile
depend:
View
@@ -1820,7 +1820,7 @@ let from_channel ~paths ic =
parse_bytecode code state (Some (symbols, crcs, prim, paths))
(* As input: list of primitives + size of global table *)
-let from_string primitives global_count code =
- let globals = make_globals global_count [||] primitives in
+let from_string primitives code =
+ let globals = make_globals 0 [||] primitives in
let state = State.initial globals in
parse_bytecode code state None
View
@@ -20,7 +20,7 @@
val from_channel : paths:string list -> in_channel -> Code.program
-val from_string : string array -> int -> string -> Code.program
+val from_string : string array -> string -> Code.program
val set_pretty : unit -> unit
View
@@ -0,0 +1,2 @@
+toplevel.cmo: ../compiler/parse.cmi ../compiler/driver.cmi
+toplevel.cmx: ../compiler/parse.cmx ../compiler/driver.cmx
View
@@ -0,0 +1,84 @@
+
+NAME=toplevel
+OBJS=toplevel.cmo
+
+all: $(NAME).js
+
+include ../Makefile.conf
+COMP=../compiler/$(COMPILER)
+JSFILES=../runtime/runtime.js ../runtime/weak.js toplevel_runtime.js
+OCAMLC=ocamlfind ocamlc -package lwt,str -pp "camlp4o ../lib/syntax/pa_js.cmo" -I ../lib -I ../compiler
+STDLIB= ../lib/$(LIBNAME).cma toplevellib.cma ../compiler/compiler.cma
+
+# Removed gc and sys
+STDLIB_MODULES=\
+ arg \
+ array \
+ arrayLabels \
+ buffer \
+ callback \
+ camlinternalLazy \
+ camlinternalMod \
+ camlinternalOO \
+ char \
+ complex \
+ digest \
+ filename \
+ format \
+ genlex \
+ hashtbl \
+ int32 \
+ int64 \
+ lazy \
+ lexing \
+ list \
+ listLabels \
+ map \
+ marshal \
+ moreLabels \
+ nativeint \
+ obj \
+ oo \
+ parsing \
+ pervasives \
+ printexc \
+ printf \
+ queue \
+ random \
+ scanf \
+ set \
+ sort \
+ stack \
+ stdLabels \
+ stream \
+ string \
+ stringLabels \
+ weak
+PERVASIVES=$(STDLIB_MODULES) outcometree topdirs toploop
+
+#toplevel.byte: $(OBJS:cmx=cmo) toplevel.cmo
+# ocamlfind ocamlc -linkall -g -package str -linkpkg toplevellib.cma -o $@.tmp $^
+
+$(NAME).js: $(NAME).byte $(COMP) $(JSFILES)
+ $(COMP) -toplevel -noinline -noruntime $(JSFILES) $(NAME).byte $(OPTIONS)
+
+$(NAME).byte: $(OBJS) ../compiler/compiler.cma
+ $(OCAMLC) -linkall -package str -linkpkg -o $@.tmp $(STDLIB) $^
+ /usr/lib/ocaml/expunge $@.tmp $@ $(PERVASIVES)
+ rm -f $@.tmp
+
+%.cmo: %.ml
+ $(OCAMLC) -c $<
+
+%.cmi: ../compiler/compiler.cma
+
+../compiler/compiler.cma:
+ $(MAKE) -C ../compiler compiler.cma
+
+clean::
+ rm -f *.cm[io] $(NAME).byte $(NAME).js
+
+depend:
+ ocamldep -pp "camlp4o ../lib/syntax/pa_js.cmo" -I ../compiler *.ml *.mli > .depend
+
+include .depend
View
@@ -0,0 +1,12 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>OCaml toplevel</title>
+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+ <script type="text/javascript" src="toplevel.js"></script>
+ </head>
+ <body id="output">
+ </body>
+</html>
View
@@ -0,0 +1,137 @@
+(* Js_of_ocaml toplevel
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2011 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+exception Bad_magic_number
+
+let exec_magic_number = "Caml1999X008"
+
+let seek_section toc ic name =
+ let rec seek_sec curr_ofs = function
+ [] -> raise Not_found
+ | (n, len) :: rem ->
+ if n = name
+ then begin seek_in ic (curr_ofs - len); len end
+ else seek_sec (curr_ofs - len) rem in
+ seek_sec (in_channel_length ic - 16 - 8 * List.length toc) toc
+
+let read_toc ic =
+ let pos_trailer = in_channel_length ic - 16 in
+ seek_in ic pos_trailer;
+ let num_sections = input_binary_int ic in
+ let header = String.create(String.length exec_magic_number) in
+ really_input ic header 0 (String.length exec_magic_number);
+ if header <> exec_magic_number then raise Bad_magic_number;
+ seek_in ic (pos_trailer - 8 * num_sections);
+ let section_table = ref [] in
+ for i = 1 to num_sections do
+ let name = String.create 4 in
+ really_input ic name 0 4;
+ let len = input_binary_int ic in
+ section_table := (name, len) :: !section_table
+ done;
+ !section_table
+
+let split_primitives p =
+ let len = String.length p in
+ let rec split beg cur =
+ if cur >= len then []
+ else if p.[cur] = '\000' then
+ String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
+ else
+ split beg (cur + 1) in
+ Array.of_list(split 0 0)
+
+let read_primitive_table toc ic =
+ let len = seek_section toc ic "PRIM" in
+ let p = String.create len in
+ really_input ic p 0 len;
+ split_primitives p
+
+(****)
+
+external global_data : unit -> Obj.t array = "caml_get_global_data"
+
+let g = global_data ()
+
+let _ =
+(*
+ Util.set_debug "parser";
+ Util.set_debug "deadcode";
+ Util.set_debug "main";
+*)
+ let toc = Obj.magic (Array.unsafe_get g (-2)) in
+ let prims = split_primitives (List.assoc "PRIM" toc) in
+
+(*XXX Integer not needed... *)
+ let compile s =
+ let p = Parse.from_string prims s in
+ let output_program = Driver.f ~standalone:false p in
+ let b = Buffer.create 100 in
+ output_program (Format.formatter_of_buffer b);
+ Buffer.contents b
+ in
+ Array.unsafe_set g (-3) (Obj.repr compile); (*XXX HACK!*)
+
+module Html = Dom_html
+
+let s =
+ "let x = 10+10;;\n\
+ let y = x * 3;;\n\
+ String.make x 'a';;\n\
+ sin 1.;;\n\
+ let rec fact n = if n = 0 then 1. else float n *. fact (n - 1);;\n\
+ fact 20;;\n"
+
+let doc = Dom_html.document
+let button_type = Js.string "button"
+let button txt action =
+ let b = Dom_html.createInput ~_type:button_type doc in
+ b##value <- Js.string txt;
+ b##onclick <- Dom_html.handler (fun _ -> action (); Js._true);
+ b
+
+let run _ =
+ let body =
+ Js.Opt.get (doc##getElementById(Js.string "output"))
+ (fun () -> assert false) in
+
+ let textbox = Html.createTextarea doc in
+ textbox##rows <- 20; textbox##cols <- 80;
+ textbox##value <- Js.string s;
+ Dom.appendChild body textbox;
+ Dom.appendChild body (Html.createBr doc);
+ let disable = ref (fun () -> ()) in
+ let b =
+ button "Run"
+ (fun () ->
+ !disable();
+ Array.unsafe_set g (-5) (Obj.repr (textbox##value)); (*XXX HACK!*)
+ ignore
+ (((*Lwt.bind (Lwt_js.yield ()) (fun () ->*)
+ begin try Topmain.main() with Not_found -> () end;
+ Lwt.return ())))
+ in
+ disable := (fun () -> b##disabled <- Js._true);
+ Dom.appendChild body b;
+ Dom.appendChild body (Html.createBr doc);
+
+ Js._false
+
+let _ = Html.window##onload <- Html.handler run
Oops, something went wrong.

0 comments on commit 21ce69e

Please sign in to comment.