From 72603f38074a67f9ab1e53df1b5fb5da3836162d Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 14 Nov 2017 02:00:14 -0400
Subject: - Implemented loop translation.

---
 .../luxc/lang/translation/procedure/common.jvm.lux | 31 +++++++++++++++++++---
 1 file changed, 27 insertions(+), 4 deletions(-)

(limited to 'new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux')

diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
index 77ce7f6fa..2cdf65e32 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
@@ -1,7 +1,10 @@
 (;module:
   lux
-  (lux (control [monad #+ do])
-       (data [text]
+  (lux (control [monad #+ do]
+                ["p" parser]
+                ["ex" exception #+ exception:])
+       (data ["e" error]
+             [text]
              text/format
              (coll [list "list/" Functor<List>]
                    [dict #+ Dict]))
@@ -19,7 +22,8 @@
               ["ls" synthesis]
               (translation [";T" runtime]
                            [";T" case]
-                           [";T" function]))))
+                           [";T" function]
+                           [";T" loop]))))
 
 (host;import java.lang.Long
   (#static MIN_VALUE Long)
@@ -160,11 +164,29 @@
   Unary
   valueI)
 
+(exception: #export Wrong-Syntax)
+(def: #export (wrong-syntax procedure args)
+  (-> Text (List ls;Synthesis) Text)
+  (format "Procedure: " procedure "\n"
+          "Arguments: " (%code (code;tuple args))))
+
+(def: lux//loop
+  (-> Text Proc)
+  (function [proc-name]
+    (function [translate inputsS]
+      (case (s;run inputsS ($_ p;seq s;nat (s;tuple (p;many s;any)) s;any))
+        (#e;Success [offset initsS+ bodyS])
+        (loopT;translate-loop translate offset initsS+ bodyS)
+
+        (#e;Error error)
+        (&;throw Wrong-Syntax (wrong-syntax proc-name inputsS)))
+      )))
+
 (def: lux//recur
   (-> Text Proc)
   (function [proc-name]
     (function [translate inputsS]
-      (functionT;translate-recur translate inputsS))))
+      (loopT;translate-recur translate inputsS))))
 
 ## [[Bits]]
 (do-template [<name> <op>]
@@ -560,6 +582,7 @@
       (install "is" (binary lux//is))
       (install "try" (unary lux//try))
       (install "if" (trinary lux//if))
+      (install "loop" lux//loop)
       (install "recur" lux//recur)
       ))
 
-- 
cgit v1.2.3