larsr/Formula.ml

## Readme.md

      
    Raw
  

              Readme.md
            
          
    Compiling ocaml into javascript.

From http://toss.sourceforge.net/ocaml.html
This OCaml code example uses the menhir parser, and the js_of_ocaml library together.  I've installed them with opam.

  
## Formula.ml
type formula =
  | Var of string
  | Not of formula
  | Or of formula * formula
  | And of formula * formula

let rec str = function
  | Var s -> s
  | Not f -> "(not " ^ (str f) ^ ")"
  | Or (f, g) -> "(" ^ (str f) ^ " or " ^ (str g) ^ ")"
  | And (f, g) -> "(" ^ (str f) ^ " and " ^ (str g) ^ ")"

let rec nnf ?(negate=false) = function
  | Var s -> if not negate then Var s else Not (Var s)
  | Not f -> nnf ~negate:(not negate) f
  | Or (f, g) -> if not negate then Or (nnf f, nnf g) else
      And (nnf ~negate:true f, nnf ~negate:true g)
  | And (f, g) -> if not negate then And (nnf f, nnf g) else
      Or (nnf ~negate:true f, nnf ~negate:true g)

let _ = print_endline (str (nnf (Not (And (Var "X", Not (Var "Y"))))))

## index.html
<html>
<head>
  <meta http-equiv="Content-Type" content="text/xhtml+xml; charset=UTF-8" />
  <title>Tutorial</title>
  <script type="text/javascript">
<!--
var worker = new Worker ("JsClient.js");
var worker_handler = new Object ();

worker.onmessage = function (m) {
    if (typeof m.data == 'string') {
        console.log("" + m.data);
    } else {
        console.log ("[ASYNCH] back from " + m.data.fname);
        var handler = worker_handler[m.data.fname];
        handler (m.data.result);
    }
}

function ASYNCH (action_name, action_args, cont) {
    worker_handler[action_name] = cont;
    worker.postMessage ({fname: action_name, args: action_args});
    console.log ("[ASYNCH] " + action_name + " (" + action_args + ")");
}

function convert_nnf () {
  var txt = document.getElementById ("formula").value;
  ASYNCH ("nnf", [txt], function (resp) { alert (resp) })
}
//-->
</script>
</head>

<body>
<textarea id="formula" rows="2" cols="40">
not (X and not Y)</textarea>
<button onclick="convert_nnf()">Convert to NNF</button>
</body>

</html>

## JsClient.ml
open Formula

(* Boilerplate code for calling OCaml in the worker thread. *)
let js_object = Js.Unsafe.variable "Object"
let js_handler = jsnew js_object ()
let postMessage = Js.Unsafe.variable "postMessage"

let log s = ignore (Js.Unsafe.call postMessage (Js.Unsafe.variable "self")
		      [|Js.Unsafe.inject (Js.string s)|])

let onmessage event =
  let fname = event##data##fname in
  let args = event##data##args in
  let handle = Js.Unsafe.get js_handler fname in
  let result = Js.Unsafe.fun_call handle (Js.to_array args) in
  let response = jsnew js_object () in
  Js.Unsafe.set response (Js.string "fname") fname;
  Js.Unsafe.set response (Js.string "result") result;
  Js.Unsafe.call postMessage (Js.Unsafe.variable "self") [|Js.Unsafe.inject response|]

let _ = Js.Unsafe.set (Js.Unsafe.variable "self") (Js.string "onmessage") onmessage

(* The NNF conversion and registration in JS. *)
let formula_of_string s = Parser.parse_formula Lexer.lex (Lexing.from_string s)
let js_nnf s =
  log ("computing nnf of " ^ (Js.to_string s));
  Js.string (str (nnf (formula_of_string (Js.to_string s))))

let _ = Js.Unsafe.set js_handler (Js.string "nnf") (Js.wrap_callback js_nnf)


## Lexer.mll
{
type token =
  | ID of (string)
  | AND
  | OR
  | NOT
  | OP
  | CL
  | EOF
}

rule lex = parse
  | [' ' '\t']      { lex lexbuf }
  | "and"           { AND }
  | "or"            { OR }
  | "not"           { NOT }
  | "("             { OP }
  | ")"             { CL }
  | ['A'-'Z' 'a'-'z' '_']['0'-'9' 'A'-'Z' 'a'-'z' '_']* as s { ID (s) }
  | eof             { EOF }

## Main.ml
open Formula
open Lexer

let formula_of_string s = Parser.parse_formula Lexer.lex (Lexing.from_string s)

let _ = print_endline (str (nnf (formula_of_string "not (X and not Y)")))

## Makefile
OCAMLC   = ocamlfind ocamlc $(PACKAGES) $(OFLAGS)

PACKAGES += js_of_ocaml
PACKAGES += js_of_ocaml.syntax

PACKAGES := $(addprefix -package , $(PACKAGES))

OFLAGS   += -syntax camlp4o

all:	Main.js JsClient.js

%.mli: %.ml
	$(OCAMLC) -i $< > $@

%.cmi: %.mli
	$(OCAMLC) -c $< -o $@

%.cmo: %.ml
	$(OCAMLC) -c $< -o $@

%.byte:
	$(OCAMLC) -linkpkg $^ -o $@

%.js: %.byte
	js_of_ocaml $<

Lexer.ml: Lexer.mll
	ocamllex $<

Parser.ml:  Lexer.cmi
	menhir --external-tokens Lexer Parser.mly

Parser.cmo: Formula.cmo Parser.cmi

JsClient.byte: Formula.cmo Lexer.cmo Parser.cmo JsClient.cmo

Main.byte: Formula.cmo Lexer.cmo Parser.cmo Main.cmo

clean:
	git clean -f -d

## Parser.mly
%token <string> ID
%token AND OR NOT OP CL EOF

%left OR AND
%nonassoc NOT

%{
  open Lexer
  open Formula
%}

%start parse_formula
%type <Formula.formula> parse_formula formula_expr

%%

%public formula_expr:
  | ID                                    { Var ($1) }
  | NOT formula_expr                      { Not ($2) }
  | formula_expr AND formula_expr         { And ($1, $3) }
  | f = formula_expr OR g = formula_expr  { Or (f, g) }
  | OP f = formula_expr CL                { f }

parse_formula:
  | formula_expr EOF                      { $1 }
	type formula =
	\| Var of string
	\| Not of formula
	\| Or of formula * formula
	\| And of formula * formula

	let rec str = function
	\| Var s -> s
	\| Not f -> "(not " ^ (str f) ^ ")"
	\| Or (f, g) -> "(" ^ (str f) ^ " or " ^ (str g) ^ ")"
	\| And (f, g) -> "(" ^ (str f) ^ " and " ^ (str g) ^ ")"

	let rec nnf ?(negate=false) = function
	\| Var s -> if not negate then Var s else Not (Var s)
	\| Not f -> nnf ~negate:(not negate) f
	\| Or (f, g) -> if not negate then Or (nnf f, nnf g) else
	And (nnf ~negate:true f, nnf ~negate:true g)
	\| And (f, g) -> if not negate then And (nnf f, nnf g) else
	Or (nnf ~negate:true f, nnf ~negate:true g)

	let _ = print_endline (str (nnf (Not (And (Var "X", Not (Var "Y"))))))
	<html>
	<head>
	<meta http-equiv="Content-Type" content="text/xhtml+xml; charset=UTF-8" />
	<title>Tutorial</title>
	<script type="text/javascript">
	<!--
	var worker = new Worker ("JsClient.js");
	var worker_handler = new Object ();

	worker.onmessage = function (m) {
	if (typeof m.data == 'string') {
	console.log("" + m.data);
	} else {
	console.log ("[ASYNCH] back from " + m.data.fname);
	var handler = worker_handler[m.data.fname];
	handler (m.data.result);
	}
	}

	function ASYNCH (action_name, action_args, cont) {
	worker_handler[action_name] = cont;
	worker.postMessage ({fname: action_name, args: action_args});
	console.log ("[ASYNCH] " + action_name + " (" + action_args + ")");
	}

	function convert_nnf () {
	var txt = document.getElementById ("formula").value;
	ASYNCH ("nnf", [txt], function (resp) { alert (resp) })
	}
	//-->
	</script>
	</head>

	<body>
	<textarea id="formula" rows="2" cols="40">
	not (X and not Y)</textarea>
	<button onclick="convert_nnf()">Convert to NNF</button>
	</body>

	</html>
	open Formula

	(* Boilerplate code for calling OCaml in the worker thread. *)
	let js_object = Js.Unsafe.variable "Object"
	let js_handler = jsnew js_object ()
	let postMessage = Js.Unsafe.variable "postMessage"

	let log s = ignore (Js.Unsafe.call postMessage (Js.Unsafe.variable "self")
	[\|Js.Unsafe.inject (Js.string s)\|])

	let onmessage event =
	let fname = event##data##fname in
	let args = event##data##args in
	let handle = Js.Unsafe.get js_handler fname in
	let result = Js.Unsafe.fun_call handle (Js.to_array args) in
	let response = jsnew js_object () in
	Js.Unsafe.set response (Js.string "fname") fname;
	Js.Unsafe.set response (Js.string "result") result;
	Js.Unsafe.call postMessage (Js.Unsafe.variable "self") [\|Js.Unsafe.inject response\|]

	let _ = Js.Unsafe.set (Js.Unsafe.variable "self") (Js.string "onmessage") onmessage

	(* The NNF conversion and registration in JS. *)
	let formula_of_string s = Parser.parse_formula Lexer.lex (Lexing.from_string s)
	let js_nnf s =
	log ("computing nnf of " ^ (Js.to_string s));
	Js.string (str (nnf (formula_of_string (Js.to_string s))))

	let _ = Js.Unsafe.set js_handler (Js.string "nnf") (Js.wrap_callback js_nnf)
	{
	type token =
	\| ID of (string)
	\| AND
	\| OR
	\| NOT
	\| OP
	\| CL
	\| EOF
	}

	rule lex = parse
	\| [' ' '\t'] { lex lexbuf }
	\| "and" { AND }
	\| "or" { OR }
	\| "not" { NOT }
	\| "(" { OP }
	\| ")" { CL }
	\| ['A'-'Z' 'a'-'z' '_']['0'-'9' 'A'-'Z' 'a'-'z' '_']* as s { ID (s) }
	\| eof { EOF }
	open Formula
	open Lexer

	let formula_of_string s = Parser.parse_formula Lexer.lex (Lexing.from_string s)

	let _ = print_endline (str (nnf (formula_of_string "not (X and not Y)")))
	OCAMLC = ocamlfind ocamlc $(PACKAGES) $(OFLAGS)

	PACKAGES += js_of_ocaml
	PACKAGES += js_of_ocaml.syntax

	PACKAGES := $(addprefix -package , $(PACKAGES))

	OFLAGS += -syntax camlp4o

	all: Main.js JsClient.js

	%.mli: %.ml
	$(OCAMLC) -i $< > $@

	%.cmi: %.mli
	$(OCAMLC) -c $< -o $@

	%.cmo: %.ml
	$(OCAMLC) -c $< -o $@

	%.byte:
	$(OCAMLC) -linkpkg $^ -o $@

	%.js: %.byte
	js_of_ocaml $<

	Lexer.ml: Lexer.mll
	ocamllex $<

	Parser.ml: Lexer.cmi
	menhir --external-tokens Lexer Parser.mly

	Parser.cmo: Formula.cmo Parser.cmi

	JsClient.byte: Formula.cmo Lexer.cmo Parser.cmo JsClient.cmo

	Main.byte: Formula.cmo Lexer.cmo Parser.cmo Main.cmo

	clean:
	git clean -f -d
	%token <string> ID
	%token AND OR NOT OP CL EOF

	%left OR AND
	%nonassoc NOT

	%{
	open Lexer
	open Formula
	%}

	%start parse_formula
	%type <Formula.formula> parse_formula formula_expr

	%%

	%public formula_expr:
	\| ID { Var ($1) }
	\| NOT formula_expr { Not ($2) }
	\| formula_expr AND formula_expr { And ($1, $3) }
	\| f = formula_expr OR g = formula_expr { Or (f, g) }
	\| OP f = formula_expr CL { f }

	parse_formula:
	\| formula_expr EOF { $1 }