diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/procedure')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux | 31 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux | 30 |
2 files changed, 39 insertions, 22 deletions
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) )) diff --git a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux index a5e06aac3..e45c0b911 100644 --- a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux @@ -25,12 +25,6 @@ ["ls" synthesis])) ["@" ../common]) -(exception: #export Wrong-Syntax) -(def: (wrong-syntax procedure args) - (-> Text (List ls;Synthesis) Text) - (format "Procedure: " procedure "\n" - "Arguments: " (%code (code;tuple args)))) - (exception: #export Invalid-Syntax-For-JVM-Type) (exception: #export Invalid-Syntax-For-Argument-Generation) @@ -304,7 +298,7 @@ ($i;array arrayJT)))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs)))) + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs)))) (def: (array//read proc translate inputs) (-> Text @;Proc) @@ -330,7 +324,7 @@ loadI))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs)))) + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs)))) (def: (array//write proc translate inputs) (-> Text @;Proc) @@ -359,7 +353,7 @@ storeI))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs)))) + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs)))) (def: array-procs @;Bundle @@ -415,7 +409,7 @@ false)))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs)))) + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs)))) (def: (object//instance? proc translate inputs) (-> Text @;Proc) @@ -428,7 +422,7 @@ ($i;wrap #$;Boolean)))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs)))) + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs)))) (def: object-procs @;Bundle @@ -479,7 +473,7 @@ (wrap ($i;GETSTATIC class field ($t;class unboxed (list)))))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs)))) + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs)))) (def: (static//put proc translate inputs) (-> Text @;Proc) @@ -511,7 +505,7 @@ ($i;string hostL;unit))))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs)))) + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs)))) (def: (virtual//get proc translate inputs) (-> Text @;Proc) @@ -542,7 +536,7 @@ ($i;GETFIELD class field ($t;class unboxed (list))))))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs)))) + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs)))) (def: (virtual//put proc translate inputs) (-> Text @;Proc) @@ -579,7 +573,7 @@ ($i;PUTFIELD class field ($t;class unboxed (list))))))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs)))) + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs)))) (def: base-type (l;Lexer $;Type) @@ -686,7 +680,7 @@ (wrap (prepare-return returnT callI))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs)))) + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs)))) (do-template [<name> <invoke> <interface?>] [(def: (<name> proc translate inputs) @@ -707,7 +701,7 @@ (wrap (prepare-return returnT callI))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs))))] + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))] [invoke//virtual $i;INVOKEVIRTUAL false] [invoke//special $i;INVOKESPECIAL false] @@ -728,7 +722,7 @@ false)))) _ - (&;throw Wrong-Syntax (wrong-syntax proc inputs)))) + (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs)))) (def: member-procs @;Bundle |