Add OCaml code generation (#24)

Also start using nailgun to speed up code generation.

  Resolves #6.

Co-authored-by: Glen Whitney <glen@studioinfinity.org>
Reviewed-on: glen/fostr#24
Co-Authored-By: Glen Whitney <glen@nobody@nowhere.net>
Co-Committed-By: Glen Whitney <glen@nobody@nowhere.net>

.drone.yml

@@ -29,7 +29,18 @@ steps:
       - java -jar /drone/lib/spt/org.metaborg.spt.cmd/target/org.metaborg.spt.cmd* -l . -s /drone/lib/spt/org.metaborg.meta.lang.spt -t tests
       - mkdir -p lib
       - curl -o lib/sunshine.jar -L 'http://artifacts.metaborg.org/service/local/artifact/maven/redirect?r=snapshots&g=org.metaborg&a=org.metaborg.sunshine2&v=LATEST'
-      - bin/fosgen tests/emit_sum.fos
+  - name: setup_gen
+    image: gcc
+    volumes:
+      - name: m2
+        path: /root/.m2
+    commands:
+      - git clone https://github.com/facebook/nailgun.git
+      - cd nailgun
+      - make
+      - cd ../bin
+      - ln -s ../nailgun/nailgun-client/target/ng .
+      - cd ..
   - name: extract_tests
     image: xonsh/xonsh
     commands:
@@ -41,7 +52,8 @@ steps:
         path: /drone/lib
       - name: m2
         path: /root/.m2
-    commands:
+    commands:  # Note we first make sure that fosgen is working
+      - bin/fosgen -d tests/emit_sum.fos
       - bin/generate_test_code
   - name: python_tests
     image: python:slim
@@ -55,6 +67,13 @@ steps:
     image: haskell
     commands:
       - bin/run_tests runghc hs
+  - name: ocaml_tests
+    image: ocaml/opam
+    commands:
+      - ls -als tests/extracted
+      - opam init
+      - eval $(opam env)
+      - bin/run_tests ocaml ml
 
 volumes:
   - name: lib

.gitignore

@@ -12,10 +12,16 @@
 
 .pydevproject
 
+a.out
+
 *.aterm
 /site
+bin/ng
 tests/extracted/*
 tests/*.js
 tests/*.py
 tests/*.hs
+tests/*.ml
+tests/*.cmi
+tests/*.cmo
 adhoc*

bin/extract_tests.xsh

@@ -19,6 +19,7 @@ EXP = 'expect'
 for path in TEST_LIST:
   destdir = pf"{DESTINATION}/{path.stem}"
   mkdir -p @(destdir)
+  chmod ugo+rwx @(destdir)
   contents = path.read_text()
   tests = re.split(r'test\s*(.+?)\s*\[\[.*?\n', contents)[1:]
   testit = iter(tests)

bin/fosgen

@@ -5,6 +5,7 @@ erro() { printf "%s\n" "$*" >&2; }
 
 ##### Set defaults:
 SUPPRESS_ERR=YES
+USE_NAILGUN=YES
 LANGUAGE=Python
 
 ##### Extract command line options:
@@ -14,18 +15,23 @@ do
     -h|--help)
       echo
       echo "Usage:"
-      echo "  fosgen [-d] [-l LANGUAGE] FILE"
+      echo "  fosgen [-d] [-j] [-l LANGUAGE] FILE"
       echo
       echo "Writes to standard output the code generated from the fostr"
       echo "program in FILE, targeting the specified LANGUAGE (which"
       echo "defaults to Python)."
       echo
       echo "The -d option writes diagnostic output to standard error."
+      echo "The -j option uses the Spoofax Sunshine JAR directly, rather"
+      echo "than via nailgun."
       exit
       ;;
     -d)
       SUPPRESS_ERR=''
       ;;
+    -j)
+      USE_NAILGUN=''
+      ;;
     -l)
       shift
       LANGUAGE="$1"
@@ -67,5 +73,17 @@ then
   exec 2>/dev/null
 fi
 
+if [[ $USE_NAILGUN ]]
+then
+  if [[ $SUPPRESS_ERR ]]
+  then
+    $BINDIR/let_sun_shine
+  else
+    $BINDIR/let_sun_shine noisy
+  fi
+  $BINDIR/ng sunshine transform -p $PROJDIR -n $LANGUAGE -i $PROGRAM
+  exit $?
+fi
+
 java -jar $SUNJAR transform -p $PROJDIR -l $PROJDIR -l $MVN_REPO -n $LANGUAGE -i $PROGRAM
 exit $?

bin/generate_test_code

@@ -4,7 +4,7 @@ failed=0
 
 for dir in tests/extracted/*; do
   for file in $dir/*.fos; do
-    for language in Python Javascript Haskell; do
+    for language in Python Javascript Haskell OCaml; do
       echo bin/fosgen -l ${language%.*} $file ...
       bin/fosgen -l $language $file
       if [[ $? -ne 0 ]]; then

bin/let_sun_shine

@@ -0,0 +1,40 @@
+#!/bin/bash
+
+# Helper for fosgen, not intended to be used directly
+# With an argument, print diagnostic output
+
+BINDIR=$(dirname $BASH_SOURCE)
+
+if $BINDIR/ng sunshine --help
+then
+  if [[ $1 ]]
+  then
+    echo "sun already shining."
+  fi
+else
+  if [[ $1 ]]
+  then
+    echo "disperse the clouds."
+  fi
+  SUNJAR="$BINDIR/../lib/sunshine.jar"
+  PROJDIR="$BINDIR/.."
+  if [[ ! $MVN_REPO ]]; then
+    MVN_REPO="$HOME/.m2/repository"
+  fi
+  if [[ ! -d $MVN_REPO ]]; then
+    MVN_REPO="/root/.m2/repository"
+  fi
+  if [[ ! -d $MVN_REPO ]]; then
+    echo "Cannot find your Maven repository. Please set environment variable"
+    echo "MVN_REPO to its full path and re-run."
+    exit 1
+  fi
+  if [[ $1 ]]
+  then 
+    java -jar $SUNJAR server & 
+  else
+    java -jar $SUNJAR server >/dev/null 2>&1 &
+  fi
+  sleep 5
+  $BINDIR/ng sunshine load -l $PROJDIR -l $MVN_REPO
+fi

editor/Generation.esv

@@ -4,3 +4,4 @@ menus
     action: "Python"     = to-python
     action: "Javascript" = to-javascript
     action: "Haskell"    = to-haskell
+    action: "OCaml"      = to-ocaml

tests/basic.spt

@@ -59,8 +59,8 @@ For example, this snippet generates the following Python:
 It generates nearly identical code in
 this simple example for Javascript (just with `"Hello, world!"`
 in place of `r'Hello, world!'`), although it generates a different
-preamble defining Stdio for each language. (Currently, Haskell code
-generation is also supported.)
+preamble defining Stdio for each language. (Currently, Haskell and OCaml
+code generation are also supported.)
 
 There's not much to break down in such a tiny program as this, but let's do
 it. The prefix operator `<<<` could be read as "the default stream receives...",
@@ -108,7 +108,7 @@ again. That way we can use the general (left-associative)
 parse to TopLevel(
   Gets(Gets(Gets(Gets(DefGets(LitString("'Two and '")),Int("2")),
                  LitString("' make '")),Sum(Int("2"),Int("2"))),
-       EscString("\"./n\"")))
+       EscString("\".\n\"")))
 /** writes
 Two and 2 make 4.
 **/

trans/fostr.str

@@ -6,6 +6,7 @@ imports
   pp
   outline
   analysis
+  ocaml
   haskell
   javascript
   python

trans/haskell.str

@@ -10,7 +10,7 @@ rules
         rule.
      C) We will use bottomup-para to traverse the full AST with the
         transformation from A so that we have access to the original expression
-        (and get get the Statix-associated type when we need to).
+        (and can get the Statix-associated type when we need to).
         Hence the transformation in (A) must actually take a pair of
         an (original) term and a term with value strings at each child,
         and be certain to return a value string.

trans/ocaml.str

@@ -0,0 +1,61 @@
+module ocaml
+imports libstrategolib signatures/- util signature/TYPE analysis
+
+/* Note will use bottomup-para to traverse the full AST so that
+   we have access to the original expression (and can get the
+   Statix-associated type when we need to).
+   
+   This means that every one of our local rules must take a pair
+   of an original term and a term with every child replaced by
+   its generated code.
+ */
+
+rules
+  ml: (_, TopLevel(x)) -> $[(* fostr preamble *)
+  type stream = { getS: string -> stream }
+  let rec stdio = {
+    getS = (fun s -> print_string s; stdio)
+  };;
+  (* End of preamble *)
+
+  [x]]
+
+  ml: (_, Stream())     -> $[stdio]
+  ml: (_, Int(x))       -> x
+  ml: (_, LitString(x)) -> $[{|[<un-single-quote>x]|}]
+  ml: (_, EscString(x)) -> x
+  ml: (_, Sum(x,y))     -> $[[x] + [y]]
+  ml: (Gets(_,yn), Gets(x, y))
+    -> $[([x]).getS ([<ml_str>(yn,y)])]
+  ml: (To(xn,_),   To(x, y))
+    -> $[let _fto = ([x]) in (ignore (([y]).getS ([<ml_str>(xn,"_fto")])); _fto)]
+  ml: (_, Terminate(x)) -> x
+  ml: (_, Sequence(l))  -> <ml_seq>l
+  
+  ml_seq: [x] -> x
+  ml_seq: [x | xs ] -> $[ignore ([x]);
+[<ml_seq>xs]]
+
+  /* One drawback of using paramorphism is we have to handle lists
+     explicitly:
+   */
+  ml: (_, []) -> []
+  ml: (_, [x | xs]) -> [x | xs]
+
+  /* Another drawback of using paramorphism is at the very leaves we have
+     to undouble the tuple:
+   */
+  ml: (x, x) -> x where <is-string>x
+
+  ml_str: (node, code) -> $[[<ml_string_cast>node]([code])]
+
+strategies
+
+  ml_string_cast = get-type; (?INT() < !"string_of_int" + !"")
+
+  ocaml = bottomup-para(try(ml))
+
+  // Interface ocaml code generation with editor services and file system
+  to-ocaml: (selected, _, _, path, project-path) -> (filename, result)
+    with filename := <guarantee-extension(|"ml")> path
+       ; result   := <ocaml> selected