diff options
Diffstat (limited to '')
31 files changed, 740 insertions, 377 deletions
diff --git a/new-luxc/source/luxc/io.jvm.lux b/new-luxc/source/luxc/io.jvm.lux index 79a4ecfc5..21c3da256 100644 --- a/new-luxc/source/luxc/io.jvm.lux +++ b/new-luxc/source/luxc/io.jvm.lux @@ -2,7 +2,7 @@ lux (lux (control monad ["ex" exception #+ exception:]) - [io #- run] + [io #+ Process] (concurrency ["P" promise] ["T" task]) (data ["e" error] @@ -21,24 +21,49 @@ (exception: #export File-Not-Found) (exception: #export Module-Not-Found) +(exception: #export Could-Not-Read-All-Data) + +(host;import #long java.io.File + (new [String]) + (exists [] #io #try boolean) + (mkdir [] #io #try boolean) + (delete [] #io #try boolean) + (length [] #io #try long) + (listFiles [] #io #try (Array java.io.File)) + (getAbsolutePath [] #io #try String) + (isFile [] #io #try boolean) + (isDirectory [] #io #try boolean)) + +(host;import java.lang.AutoCloseable + (close [] #io #try void)) + +(host;import java.io.InputStream + (read [(Array byte)] #io #try int)) + +(host;import java.io.FileInputStream + (new [java.io.File] #io #try)) + +(def: file-exists? + (-> File (Process Bool)) + (|>. java.io.File.new (java.io.File.exists []))) (def: (find-source path dirs) - (-> Text (List File) (T;Task [Text File])) + (-> Text (List File) (Process [Text File])) (case dirs #;Nil - (T;throw File-Not-Found path) + (io;fail (File-Not-Found path)) (#;Cons dir dirs') - (do T;Monad<Task> + (do io;Monad<Process> [#let [file (format dir "/" path)] - ? (file;exists? file)] + ? (file-exists? file)] (if ? (wrap [path file]) (find-source path dirs'))))) (def: (either left right) - (All [a] (-> (T;Task a) (T;Task a) (T;Task a))) - (do P;Monad<Promise> + (All [a] (-> (Process a) (Process a) (Process a))) + (do io;Monad<IO> [?output left] (case ?output (#e;Success output) @@ -47,17 +72,30 @@ (#e;Error error) right))) +(def: #export (read-file file) + (-> File (Process Blob)) + (do io;Monad<Process> + [#let [file' (java.io.File.new file)] + size (java.io.File.length [] file') + #let [data (blob;create (int-to-nat size))] + stream (FileInputStream.new [file']) + bytes-read (InputStream.read [data] stream) + _ (AutoCloseable.close [] stream)] + (if (i.= size bytes-read) + (wrap data) + (io;fail (Could-Not-Read-All-Data file))))) + (def: #export (read-module dirs name) - (-> (List File) Text (T;Task [File Text])) + (-> (List File) Text (Process [File Text])) (let [host-path (format name host-extension lux-extension) lux-path (format name lux-extension)] - (do T;Monad<Task> - [[path file] (: (T;Task [Text File]) + (do io;Monad<Process> + [[path file] (: (Process [Text File]) ($_ either (find-source host-path dirs) (find-source lux-path dirs) - (T;throw Module-Not-Found name))) - blob (file;read file)] + (io;fail (Module-Not-Found name)))) + blob (read-file file)] (wrap [path (String.new blob)])))) (def: #export (write-module name descriptor) @@ -69,11 +107,6 @@ (format root-target "/" (for {"JVM" "jvm" "JS" "js"}))) -(def: (platform-file root-file) - (-> File File) - (format root-file (for {"JVM" ".class" - "JS" ".js"}))) - (def: #export (prepare-target target-dir) (-> File (T;Task Unit)) (do T;Monad<Task> @@ -89,6 +122,6 @@ (def: #export (write-file target-dir file-name content) (-> File Text Blob (T;Task Unit)) - (file;write content - (format (platform-target target-dir) - "/" (platform-file file-name)))) + (|> file-name + (format (platform-target target-dir) "/") + (file;write content))) diff --git a/new-luxc/source/luxc/lang.lux b/new-luxc/source/luxc/lang.lux index 4aa47754a..b85409fb9 100644 --- a/new-luxc/source/luxc/lang.lux +++ b/new-luxc/source/luxc/lang.lux @@ -243,3 +243,15 @@ (if (n.= underflow idx) output (recur (n.dec idx) (format (|> (text;nth idx name) maybe;assume normalize-char) output))))) + +(exception: #export Error) + +(def: #export (with-error-tracking action) + (All [a] (-> (Meta a) (Meta a))) + (function [compiler] + (case (action compiler) + (#e;Error error) + ((throw Error error) compiler) + + output + output))) diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux index 5d4c592aa..4a28ce436 100644 --- a/new-luxc/source/luxc/lang/analysis/case.lux +++ b/new-luxc/source/luxc/lang/analysis/case.lux @@ -239,7 +239,7 @@ (^ [cursor (#;Form (list& [_ (#;Tag tag)] values))]) (&;with-cursor cursor (do macro;Monad<Meta> - [tag (macro;normalize tag) + [tag (macro;canonical tag) [idx group variantT] (macro;resolve-tag tag) _ (&;with-type-env (tc;check inputT variantT))] diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux index 5d38f7626..89fb3b93e 100644 --- a/new-luxc/source/luxc/lang/analysis/expression.lux +++ b/new-luxc/source/luxc/lang/analysis/expression.lux @@ -29,14 +29,14 @@ (def: #export (analyser eval) (-> &;Eval &;Analyser) (: (-> Code (Meta la;Analysis)) - (function analyse [ast] + (function analyse [code] (do macro;Monad<Meta> [expectedT macro;expected-type] - (let [[cursor ast'] ast] + (let [[cursor code'] code] ## The cursor must be set in the compiler for the sake ## of having useful error messages. (&;with-cursor cursor - (case ast' + (case code' (^template [<tag> <analyser>] (<tag> value) (<analyser> value)) @@ -83,16 +83,18 @@ (^ (#;Form (list& func args))) (do macro;Monad<Meta> - [[funcT =func] (commonA;with-unknown-type + [[funcT funcA] (commonA;with-unknown-type (analyse func))] - (case =func + (case funcA [_ (#;Symbol def-name)] (do @ - [[def-type def-anns def-value] (macro;find-def def-name)] - (if (macro;macro? def-anns) + [?macro (&;with-error-tracking + (macro;find-macro def-name))] + (case ?macro + (#;Some macro) (do @ [expansion (function [compiler] - (case (macroL;expand (:! Macro def-value) args compiler) + (case (macroL;expand macro args compiler) (#e;Success [compiler' output]) (#e;Success [compiler' output]) @@ -103,12 +105,14 @@ (analyse single) _ - (&;throw Macro-Expression-Must-Have-Single-Expansion (%code ast)))) - (functionA;analyse-apply analyse funcT =func args))) + (&;throw Macro-Expression-Must-Have-Single-Expansion (%code code)))) + + _ + (functionA;analyse-apply analyse funcT funcA args))) _ - (functionA;analyse-apply analyse funcT =func args))) + (functionA;analyse-apply analyse funcT funcA args))) _ - (&;throw Unrecognized-Syntax (%code ast)) + (&;throw Unrecognized-Syntax (%code code)) ))))))) diff --git a/new-luxc/source/luxc/lang/analysis/reference.lux b/new-luxc/source/luxc/lang/analysis/reference.lux index 25b33881c..7475f269f 100644 --- a/new-luxc/source/luxc/lang/analysis/reference.lux +++ b/new-luxc/source/luxc/lang/analysis/reference.lux @@ -13,9 +13,16 @@ (def: (analyse-definition def-name) (-> Ident (Meta Analysis)) (do macro;Monad<Meta> - [actualT (macro;find-def-type def-name) - _ (&;infer actualT)] - (wrap (code;symbol def-name)))) + [[actualT def-anns _] (&;with-error-tracking + (macro;find-def def-name))] + (case (macro;get-symbol-ann (ident-for #;alias) def-anns) + (#;Some real-def-name) + (analyse-definition real-def-name) + + _ + (do @ + [_ (&;infer actualT)] + (wrap (code;symbol def-name)))))) (def: (analyse-variable var-name) (-> Text (Meta (Maybe Analysis))) diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux index 2292d93cf..19eebbc46 100644 --- a/new-luxc/source/luxc/lang/analysis/structure.lux +++ b/new-luxc/source/luxc/lang/analysis/structure.lux @@ -235,7 +235,7 @@ (def: #export (analyse-tagged-sum analyse tag valueC) (-> &;Analyser Ident Code (Meta la;Analysis)) (do macro;Monad<Meta> - [tag (macro;normalize tag) + [tag (macro;canonical tag) [idx group variantT] (macro;resolve-tag tag) expectedT macro;expected-type] (case expectedT @@ -261,7 +261,7 @@ (case key [_ (#;Tag key)] (do macro;Monad<Meta> - [key (macro;normalize key)] + [key (macro;canonical key)] (wrap [key val])) _ @@ -281,7 +281,7 @@ (#;Cons [head-k head-v] _) (do macro;Monad<Meta> - [head-k (macro;normalize head-k) + [head-k (macro;canonical head-k) [_ tag-set recordT] (macro;resolve-tag head-k) #let [size-record (list;size record) size-ts (list;size tag-set)] @@ -296,7 +296,7 @@ idx->val (monad;fold @ (function [[key val] idx->val] (do @ - [key (macro;normalize key)] + [key (macro;canonical key)] (case (dict;get key tag->idx) #;None (&;throw Tag-Does-Not-Belong-To-Record @@ -323,14 +323,20 @@ (-> &;Analyser (List [Code Code]) (Meta la;Analysis)) (do macro;Monad<Meta> [members (normalize members) - [membersC recordT] (order members) - expectedT macro;expected-type] - (case expectedT - (#;Var _) - (do @ - [inferenceT (&inference;record recordT) - [inferredT membersA] (&inference;general analyse inferenceT membersC)] - (wrap (la;product membersA))) + [membersC recordT] (order members)] + (case membersC + (^ (list singletonC)) + (analyse singletonC) _ - (analyse-product analyse membersC)))) + (do @ + [expectedT macro;expected-type] + (case expectedT + (#;Var _) + (do @ + [inferenceT (&inference;record recordT) + [inferredT membersA] (&inference;general analyse inferenceT membersC)] + (wrap (la;product membersA))) + + _ + (analyse-product analyse membersC)))))) diff --git a/new-luxc/source/luxc/lang/host.jvm.lux b/new-luxc/source/luxc/lang/host.jvm.lux index 726bb5bbc..9f8fcd069 100644 --- a/new-luxc/source/luxc/lang/host.jvm.lux +++ b/new-luxc/source/luxc/lang/host.jvm.lux @@ -3,7 +3,7 @@ (lux (control [monad #+ do] ["ex" exception #+ exception:] pipe) - (concurrency ["A" atom]) + (concurrency [atom #+ Atom atom]) (data ["e" error] [text] text/format @@ -62,11 +62,11 @@ (def: (fetch-byte-code class-name store) (-> Text commonT;Class-Store (Maybe commonT;Bytecode)) - (|> store A;get io;run (dict;get class-name))) + (|> store atom;read io;run (dict;get class-name))) (def: (memory-class-loader store) (-> commonT;Class-Store ClassLoader) - (object ClassLoader [] + (object [] ClassLoader [] [] (ClassLoader (findClass [class-name String]) Class (case (fetch-byte-code class-name store) @@ -85,7 +85,7 @@ (def: #export init-host (io;IO commonT;Host) (io;io (let [store (: commonT;Class-Store - (A;atom (dict;new text;Hash<Text>)))] + (atom (dict;new text;Hash<Text>)))] {#commonT;loader (memory-class-loader store) #commonT;store store #commonT;artifacts (dict;new text;Hash<Text>) diff --git a/new-luxc/source/luxc/lang/module.lux b/new-luxc/source/luxc/lang/module.lux index 2b855d927..f6cffa9c6 100644 --- a/new-luxc/source/luxc/lang/module.lux +++ b/new-luxc/source/luxc/lang/module.lux @@ -1,7 +1,8 @@ (;module: lux (lux (control [monad #+ do] - ["ex" exception #+ exception:]) + ["ex" exception #+ exception:] + pipe) (data [text "text/" Eq<Text>] text/format ["e" error] @@ -15,6 +16,9 @@ (exception: #export Cannot-Declare-Tag-Twice) (exception: #export Cannot-Declare-Tags-For-Unnamed-Type) (exception: #export Cannot-Declare-Tags-For-Foreign-Type) +(exception: #export Cannot-Define-More-Than-Once) +(exception: #export Cannot-Define-In-Unknown-Module) +(exception: #export Can-Only-Change-State-Of-Active-Module) (def: (new-module hash) (-> Nat Module) @@ -27,6 +31,45 @@ #;module-annotations (' {}) #;module-state #;Active}) +(def: #export (set-annotations annotations) + (-> Code (Meta Unit)) + (do macro;Monad<Meta> + [self macro;current-module-name] + (function [compiler] + (#e;Success [(update@ #;modules + (&;pl-update self (set@ #;module-annotations annotations)) + compiler) + []])))) + +(def: #export (import module) + (-> Text (Meta Unit)) + (do macro;Monad<Meta> + [self macro;current-module-name] + (function [compiler] + (#e;Success [(update@ #;modules + (&;pl-update self (update@ #;imports (|>. (#;Cons module)))) + compiler) + []])))) + +(def: #export (alias alias module) + (-> Text Text (Meta Unit)) + (do macro;Monad<Meta> + [self macro;current-module-name] + (function [compiler] + (#e;Success [(update@ #;modules + (&;pl-update self (update@ #;module-aliases (: (-> (List [Text Text]) (List [Text Text])) + (|>. (#;Cons [alias module]))))) + compiler) + []])))) + +(def: #export (exists? module) + (-> Text (Meta Bool)) + (function [compiler] + (|> (get@ #;modules compiler) + (&;pl-get module) + (case> (#;Some _) true #;None false) + [compiler] #e;Success))) + (def: #export (define (^@ full-name [module-name def-name]) definition) (-> Ident Def (Meta Unit)) @@ -45,10 +88,10 @@ []]) (#;Some already-existing) - (#e;Error (format "Cannot re-define definiton: " (%ident full-name)))) + ((&;throw Cannot-Define-More-Than-Once (%ident full-name)) compiler)) #;None - (#e;Error (format "Cannot define in unknown module: " module-name))))) + ((&;throw Cannot-Define-In-Unknown-Module (%ident full-name)) compiler)))) (def: #export (create hash name) (-> Nat Text (Meta Module)) @@ -64,11 +107,11 @@ (do macro;Monad<Meta> [_ (create hash name) output (&;with-current-module name - (&scope;with-scope name action)) + action) module (macro;find-module name)] (wrap [module output]))) -(do-template [<flagger> <asker> <tag>] +(do-template [<flagger> <asker> <tag> <description>] [(def: #export (<flagger> module-name) (-> Text (Meta Unit)) (function [compiler] @@ -82,10 +125,13 @@ (&;pl-put module-name (set@ #;module-state <tag> module)) compiler) []]) - (#e;Error "Can only change the state of a currently-active module."))) + ((&;throw Can-Only-Change-State-Of-Active-Module + (format " Module: " module-name "\n" + "Desired state: " <description>)) + compiler))) #;None - (#e;Error (format "Module does not exist: " module-name))))) + ((&;throw Unknown-Module module-name) compiler)))) (def: #export (<asker> module-name) (-> Text (Meta Bool)) (function [compiler] @@ -97,12 +143,12 @@ _ false)]) #;None - (#e;Error (format "Module does not exist: " module-name))) + ((&;throw Unknown-Module module-name) compiler)) ))] - [flag-active! active? #;Active] - [flag-compiled! compiled? #;Compiled] - [flag-cached! cached? #;Cached] + [flag-active! active? #;Active "Active"] + [flag-compiled! compiled? #;Compiled "Compiled"] + [flag-cached! cached? #;Cached "Cached"] ) (do-template [<name> <tag> <type>] @@ -114,7 +160,7 @@ (#e;Success [compiler (get@ <tag> module)]) #;None - (macro;run compiler (&;throw Unknown-Module module-name))) + ((&;throw Unknown-Module module-name) compiler)) ))] [tags-by-module #;tags (List [Text [Nat (List Ident) Bool Type]])] @@ -170,4 +216,4 @@ compiler) []])) #;None - (macro;run compiler (&;throw Unknown-Module current-module)))))) + ((&;throw Unknown-Module current-module) compiler))))) diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux index dd84ad024..33f74795a 100644 --- a/new-luxc/source/luxc/lang/translation.lux +++ b/new-luxc/source/luxc/lang/translation.lux @@ -2,16 +2,18 @@ lux (lux (control [monad #+ do] ["ex" exception #+ exception:]) - (concurrency ["T" task]) + (concurrency ["P" promise] + ["T" task]) (data ["e" error] [text "text/" Hash<Text>] text/format - (coll [dict])) + (coll [list] + [dict])) [macro] (lang [syntax] (type ["tc" check])) [host] - [io] + [io #+ IO Process io] (world [file #+ File])) (luxc ["&" lang] ["&;" io] @@ -26,7 +28,8 @@ [";T" statement] [";T" common] [";T" expression] - [";T" eval]) + [";T" eval] + [";T" imports]) ["&;" eval]) )) @@ -36,6 +39,7 @@ (exception: #export Macro-Expansion-Failed) (exception: #export Unrecognized-Statement) +(exception: #export Invalid-Alias) (def: (process-annotations annsC) (-> Code (Meta [$;Inst Code])) @@ -47,58 +51,92 @@ annsV (evalT;eval annsI)] (wrap [annsI (:! Code annsV)]))) -(def: (translate code) - (-> Code (Meta Unit)) - (case code - (^code ("lux def" (~ [_ (#;Symbol ["" def-name])]) (~ valueC) (~ annsC))) - (hostL;with-context def-name - (&;with-fresh-type-env - (do macro;Monad<Meta> - [[annsI annsV] (process-annotations annsC) - [_ valueT valueA] (&;with-scope - (if (macro;type? (:! Code annsV)) - (do @ - [valueA (&;with-type Type - (analyse valueC))] - (wrap [Type valueA])) - (commonA;with-unknown-type - (analyse valueC)))) - valueT (&;with-type-env - (tc;clean valueT)) - valueI (expressionT;translate (expressionS;synthesize valueA)) - _ (&;with-scope - (statementT;translate-def def-name valueT valueI annsI annsV))] - (wrap [])))) +(def: (switch-compiler new-compiler) + (-> Compiler (Meta Unit)) + (function [old-compiler] + (#e;Success [new-compiler []]))) - (^code ("lux program" (~ [_ (#;Symbol ["" program-args])]) (~ programC))) - (do macro;Monad<Meta> - [[_ programA] (&;with-scope - (&;with-type (type (io;IO Unit)) - (analyse programC))) - programI (expressionT;translate (expressionS;synthesize programA))] - (statementT;translate-program program-args programI)) +(def: (ensure-valid-alias def-name annotations value) + (-> Text Code Code (Meta Unit)) + (case [annotations value] + (^multi [[_ (#;Record pairs)] [_ (#;Symbol _)]] + (|> pairs list;size (n.= +1))) + (:: macro;Monad<Meta> wrap []) - (^code ("lux module" (~ annsC))) - (do macro;Monad<Meta> - [[annsI annsV] (process-annotations annsC)] - (&;fail (%code annsV))) + _ + (&;throw Invalid-Alias def-name))) +(def: (translate translate-module code) + (-> (-> Text Compiler (Process Compiler)) Code (Meta Unit)) + (case code (^code ((~ [_ (#;Symbol macro-name)]) (~@ args))) (do macro;Monad<Meta> - [macro-name (macro;normalize macro-name) - [def-type def-anns def-value] (macro;find-def macro-name)] - (if (macro;macro? def-anns) + [?macro (&;with-error-tracking + (macro;find-macro macro-name))] + (case ?macro + (#;Some macro) (do @ [expansion (function [compiler] - (case (macroL;expand (:! Macro def-value) args compiler) + (case (macroL;expand macro args compiler) (#e;Success [compiler' output]) (#e;Success [compiler' output]) (#e;Error error) ((&;throw Macro-Expansion-Failed error) compiler))) - _ (monad;map @ translate expansion)] + _ (monad;map @ (translate translate-module) expansion)] (wrap [])) + + #;None (&;throw Unrecognized-Statement (%code code)))) + + (^code ("lux def" (~ [_ (#;Symbol ["" def-name])]) (~ valueC) (~ annsC))) + (hostL;with-context def-name + (&;with-fresh-type-env + (do macro;Monad<Meta> + [[annsI annsV] (process-annotations annsC)] + (case (macro;get-symbol-ann (ident-for #;alias) annsV) + (#;Some real-def) + (do @ + [_ (ensure-valid-alias def-name annsV valueC) + _ (&;with-scope + (statementT;translate-def def-name Void id annsI annsV))] + (wrap [])) + + #;None + (do @ + [[_ valueT valueA] (&;with-scope + (if (macro;type? (:! Code annsV)) + (do @ + [valueA (&;with-type Type + (analyse valueC))] + (wrap [Type valueA])) + (commonA;with-unknown-type + (analyse valueC)))) + valueT (&;with-type-env + (tc;clean valueT)) + valueI (expressionT;translate (expressionS;synthesize valueA)) + _ (&;with-scope + (statementT;translate-def def-name valueT valueI annsI annsV))] + (wrap [])))))) + + (^code ("lux module" (~ annsC))) + (do macro;Monad<Meta> + [[annsI annsV] (process-annotations annsC) + process (importsT;translate-imports translate-module annsV)] + (case (io;run process) + (#e;Success compiler') + (switch-compiler compiler') + + (#e;Error error) + (macro;fail error))) + + (^code ("lux program" (~ [_ (#;Symbol ["" program-args])]) (~ programC))) + (do macro;Monad<Meta> + [[_ programA] (&;with-scope + (&;with-type (type (io;IO Unit)) + (analyse programC))) + programI (expressionT;translate (expressionS;synthesize programA))] + (statementT;translate-program program-args programI)) _ (&;throw Unrecognized-Statement (%code code)))) @@ -126,10 +164,10 @@ _ (moduleL;flag-compiled! module-name)] (wrap output))) -(def: (parse current-module) +(def: (read current-module) (-> Text (Meta Code)) (function [compiler] - (case (syntax;parse current-module (get@ #;source compiler)) + (case (syntax;read current-module (get@ #;source compiler)) (#e;Error error) (#e;Error error) @@ -138,11 +176,13 @@ output])))) (def: (translate-module source-dirs target-dir module-name compiler) - (-> (List File) File Text Compiler (T;Task Compiler)) - (do T;Monad<Task> - [_ (&io;prepare-module target-dir module-name) + (-> (List File) File Text Compiler (Process Compiler)) + (do io;Monad<Process> + [#let [_ (log! (format "{translate-module} " module-name))] + ## _ (&io;prepare-module target-dir module-name) [file-name file-content] (&io;read-module source-dirs module-name) - #let [module-hash (text/hash file-content)]] + #let [module-hash (text/hash file-content) + translate-module (translate-module source-dirs target-dir)]] (case (macro;run' compiler (do macro;Monad<Meta> [[_ artifacts _] (moduleL;with-module module-hash module-name @@ -152,20 +192,21 @@ file-content] (exhaust (do @ - [code (parse module-name) + [code (read module-name) #let [[cursor _] code]] (&;with-cursor cursor - (translate code)))))))] + (translate translate-module code)))))))] (wrap artifacts))) (#e;Success [compiler artifacts]) (do @ - [_ (monad;map @ (function [[class-name class-bytecode]] - (&io;write-file target-dir class-name class-bytecode)) - (dict;entries artifacts))] + [## _ (monad;map @ (function [[class-name class-bytecode]] + ## (&io;write-file target-dir class-name class-bytecode)) + ## (dict;entries artifacts)) + ] (wrap compiler)) (#e;Error error) - (T;fail error)))) + (io;fail error)))) (def: init-cursor Cursor ["" +1 +0]) @@ -177,7 +218,8 @@ (def: #export init-info Info - {#;target "JVM" + {#;target (for {"JVM" "JVM" + "JS" "JS"}) #;version &;version #;mode #;Build}) @@ -205,11 +247,11 @@ (#e;Success [compiler [runtime-bc function-bc]]) (do @ [_ (&io;prepare-target target) - _ (&io;write-file target hostL;runtime-class runtime-bc) - _ (&io;write-file target hostL;function-class function-bc)] + _ (&io;write-file target (format hostL;runtime-class ".class") runtime-bc) + _ (&io;write-file target (format hostL;function-class ".class") function-bc)] (wrap compiler))) (: (T;Task Compiler)) - (:: @ map (translate-module sources target prelude)) (:: @ join) - (:: @ map (translate-module sources target program)) (:: @ join)) + (:: @ map (|>. (translate-module sources target prelude) P;future)) (:: @ join) + (:: @ map (|>. (translate-module sources target program) P;future)) (:: @ join)) #let [_ (log! "Compilation complete!")]] (wrap []))) diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux index 49e135709..7a16a749a 100644 --- a/new-luxc/source/luxc/lang/translation/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux @@ -2,7 +2,7 @@ [lux #- function] (lux (control ["ex" exception #+ exception:]) [io] - (concurrency ["A" atom]) + (concurrency [atom #+ Atom atom]) (data ["e" error] [text] text/format @@ -30,7 +30,7 @@ (type: #export Bytecode Blob) -(type: #export Class-Store (A;Atom (Dict Text Bytecode))) +(type: #export Class-Store (Atom (Dict Text Bytecode))) (type: #export Artifacts (Dict File Blob)) @@ -84,16 +84,16 @@ (let [store (|> (get@ #;host compiler) (:! Host) (get@ #store))] - (if (dict;contains? name (|> store A;get io;run)) + (if (dict;contains? name (|> store atom;read io;run)) (ex;throw Class-Already-Stored name) - (#e;Success [compiler (io;run (A;update (dict;put name byte-code) store))]) + (#e;Success [compiler (io;run (atom;update (dict;put name byte-code) store))]) )))) (def: #export (load-class name) (-> Text (Meta (Class Object))) (;function [compiler] (let [host (:! Host (get@ #;host compiler)) - store (|> host (get@ #store) A;get io;run)] + store (|> host (get@ #store) atom;read io;run)] (if (dict;contains? name store) (#e;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))]) (ex;throw Unknown-Class name))))) diff --git a/new-luxc/source/luxc/lang/translation/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/eval.jvm.lux index 11baa3856..6b9ee9743 100644 --- a/new-luxc/source/luxc/lang/translation/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/eval.jvm.lux @@ -1,7 +1,8 @@ (;module: lux (lux (control monad) - (data text/format) + (data [text] + text/format) [macro] [host #+ do-to]) (luxc ["&" lang] @@ -56,8 +57,10 @@ (def: #export (eval valueI) (-> $;Inst (Meta Top)) (do macro;Monad<Meta> - [class-name (:: @ map %code (macro;gensym "eval")) - #let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS) + [current-module macro;current-module-name + class-name (:: @ map %code (macro;gensym (format current-module "/eval"))) + #let [store-name (text;replace-all "/" "." class-name) + writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS) (ClassWriter.visit [commonT;bytecode-version (i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_SUPER) class-name @@ -70,11 +73,11 @@ "<clinit>" ($t;method (list) #;None (list)) (|>. valueI - ($i;PUTSTATIC class-name commonT;value-field commonT;$Object) + ($i;PUTSTATIC store-name commonT;value-field commonT;$Object) $i;RETURN))) bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))] - _ (commonT;store-class class-name bytecode) - class (commonT;load-class class-name)] + _ (commonT;store-class store-name bytecode) + class (commonT;load-class store-name)] (wrap (|> class (Class.getField [commonT;value-field]) (Field.get (host;null)))))) diff --git a/new-luxc/source/luxc/lang/translation/function.jvm.lux b/new-luxc/source/luxc/lang/translation/function.jvm.lux index d8a2077bc..ab3382952 100644 --- a/new-luxc/source/luxc/lang/translation/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/function.jvm.lux @@ -291,6 +291,8 @@ [function-class bodyI] (hostL;with-sub-context (hostL;with-anchor [@begin +1] (translate bodyS))) + this-module macro;current-module-name + #let [function-class (format (text;replace-all "/" "." this-module) "." function-class)] [functionD instanceI] (with-function @begin function-class env arity bodyI) _ (commonT;store-class function-class ($d;class #$;V1.6 #$;Public $;finalC diff --git a/new-luxc/source/luxc/lang/translation/imports.jvm.lux b/new-luxc/source/luxc/lang/translation/imports.jvm.lux new file mode 100644 index 000000000..c30f61225 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/imports.jvm.lux @@ -0,0 +1,150 @@ +(;module: + lux + (lux (control [monad #+ do] + ["p" parser] + ["ex" exception #+ exception:] + pipe) + (concurrency [promise #+ Promise] + [stm #+ Var STM]) + (data ["e" error #+ Error] + [maybe] + [product] + [text "text/" Eq<Text>] + text/format + (coll [list "list/" Functor<List> Fold<List>] + [dict #+ Dict])) + [macro] + (macro [code] + ["s" syntax]) + [io #+ IO Process io] + [host]) + (luxc ["&" lang] + (lang [";L" module]))) + +(exception: #export Invalid-Imports) +(exception: #export Module-Cannot-Import-Itself) +(exception: #export Circular-Dependency) + +(host;import (java.util.concurrent.Future a) + (get [] #io a)) + +(host;import (java.util.concurrent.CompletableFuture a) + (new []) + (complete [a] boolean) + (#static [a] completedFuture [a] (CompletableFuture a))) + +(type: Import + {#module Text + #alias Text}) + +(def: import (s;Syntax Import) (s;tuple (p;seq s;text s;text))) + +(def: compilations + (Var (Dict Text (CompletableFuture (Error Compiler)))) + (stm;var (dict;new text;Hash<Text>))) + +(def: (promise-to-future promise) + (All [a] (-> (Promise a) (Future a))) + (let [future (CompletableFuture.new [])] + (exec (:: promise;Functor<Promise> map + (function [value] (CompletableFuture.complete [value] future)) + promise) + future))) + +(def: from-io + (All [a] (-> (IO a) (Process a))) + (:: io;Monad<IO> map (|>. #e;Success))) + +(def: (translate-dependency translate-module dependency compiler) + (-> (-> Text Compiler (Process Compiler)) + (-> Text Compiler (IO (Future (Error Compiler))))) + (<| (Future.get []) + promise-to-future + (do promise;Monad<Promise> + [[new? future] (stm;commit (: (STM [Bool (CompletableFuture (Error Compiler))]) + (do stm;Monad<STM> + [current-compilations (stm;read compilations)] + (case (dict;get dependency current-compilations) + (#;Some ongoing) + (wrap [false ongoing]) + + #;None + (do @ + [#let [pending (: (CompletableFuture (Error Compiler)) + (CompletableFuture.new []))] + _ (stm;write (dict;put dependency pending current-compilations) + compilations)] + (wrap [true pending]))))))] + (if new? + (exec (promise;future (io (CompletableFuture.complete [(io;run (translate-module dependency compiler))] + future))) + (wrap future)) + (wrap future))))) + +(def: compiled? + (-> Module Bool) + (|>. (get@ #;module-state) + (case> + (^or #;Cached #;Compiled) + true + + _ + false))) + +(def: (merge-modules current-module from-dependency from-current) + (-> Text (List [Text Module]) (List [Text Module]) (List [Text Module])) + (|> from-dependency + (list;filter (|>. product;right compiled?)) + (list/fold (function [[dep-name dep-module] total] (&;pl-put dep-name dep-module total)) + from-current))) + +(def: (merge-compilers current-module dependency total) + (-> Text Compiler Compiler Compiler) + (|> total + (update@ #;modules (merge-modules current-module (get@ #;modules dependency))) + (set@ #;seed (get@ #;seed dependency)))) + +(def: #export (translate-imports translate-module annotations) + (-> (-> Text Compiler (Process Compiler)) + Code + (Meta (Process Compiler))) + (do macro;Monad<Meta> + [_ (moduleL;set-annotations annotations) + current-module macro;current-module-name + #let [_ (log! (format "{translate-imports} " current-module))] + imports (let [imports (|> (macro;get-tuple-ann (ident-for #;imports) annotations) + (maybe;default (list)))] + (case (s;run imports (p;some import)) + (#e;Success imports) + (wrap imports) + + (#e;Error error) + (&;throw Invalid-Imports (%code (code;tuple imports))))) + dependencies (monad;map @ (: (-> [Text Text] (Meta (IO (Future (Error Compiler))))) + (function [[dependency alias]] + (do @ + [_ (&;assert Module-Cannot-Import-Itself current-module + (not (text/= current-module dependency))) + already-seen? (moduleL;exists? dependency) + circular-dependency? (if already-seen? + (moduleL;active? dependency) + (wrap false)) + _ (&;assert Circular-Dependency (format "From: " current-module "\n" + " To: " dependency) + (not circular-dependency?)) + _ (moduleL;import dependency) + _ (if (text/= "" alias) + (wrap []) + (moduleL;alias alias dependency)) + compiler macro;get-compiler] + (if already-seen? + (wrap (io (CompletableFuture.completedFuture [(#e;Success compiler)]))) + (wrap (translate-dependency translate-module dependency compiler)))))) + imports) + compiler macro;get-compiler] + (wrap (do io;Monad<Process> + [dependencies (monad;seq io;Monad<Process> (list/map from-io dependencies)) + dependencies (|> dependencies + (list/map (Future.get [])) + (monad;seq io;Monad<Process>))] + (wrap (list/fold (merge-compilers current-module) compiler dependencies)))))) diff --git a/new-luxc/source/luxc/lang/translation/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/reference.jvm.lux index 9d0cc91e4..bfc838041 100644 --- a/new-luxc/source/luxc/lang/translation/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/reference.jvm.lux @@ -25,7 +25,9 @@ (def: #export (translate-captured variable) (-> Variable (Meta $;Inst)) (do macro;Monad<Meta> - [function-class hostL;context] + [this-module macro;current-module-name + function-class hostL;context + #let [function-class (format (text;replace-all "/" "." this-module) "." function-class)]] (wrap (|>. ($i;ALOAD +0) ($i;GETFIELD function-class (|> variable i.inc (i.* -1) int-to-nat captured) diff --git a/new-luxc/source/luxc/lang/translation/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/statement.jvm.lux index 387181f98..df7e26741 100644 --- a/new-luxc/source/luxc/lang/translation/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/statement.jvm.lux @@ -36,48 +36,57 @@ (-> Text Type $;Inst $;Inst Code (Meta Unit)) (do macro;Monad<Meta> [current-module macro;current-module-name - #let [def-ident [current-module def-name] - normal-name (format (&;normalize-name def-name) (%n (text/hash def-name))) - bytecode-name (format current-module "/" normal-name) - class-name (format current-module "." normal-name) - bytecode ($d;class #$;V1.6 - #$;Public $;finalC - bytecode-name - (list) ["java.lang.Object" (list)] - (list) - (|>. ($d;field #$;Public ($;++F $;finalF $;staticF) commonT;value-field commonT;$Object) - ($d;method #$;Public $;staticM "<clinit>" ($t;method (list) #;None (list)) - (|>. valueI - ($i;PUTSTATIC bytecode-name commonT;value-field commonT;$Object) - $i;RETURN))))] - _ (commonT;store-class class-name bytecode) - class (commonT;load-class class-name) - valueV (: (Meta Top) - (case (do e;Monad<Error> - [field (Class.getField [commonT;value-field] class)] - (Field.get [#;None] field)) - (#e;Success #;None) - (&;throw Invalid-Definition-Value (%ident def-ident)) - - (#e;Success (#;Some valueV)) - (wrap valueV) - - (#e;Error error) - (&;throw Cannot-Evaluate-Definition - (format "Definition: " (%ident def-ident) "\n" - "Error:\n" - error)))) - _ (&module;define def-ident [valueT metaV valueV]) - _ (if (macro;type? metaV) - (case (macro;declared-tags metaV) - #;Nil - (wrap []) + #let [def-ident [current-module def-name]]] + (case (macro;get-symbol-ann (ident-for #;alias) metaV) + (#;Some real-def) + (do @ + [[realT realA realV] (macro;find-def real-def) + _ (&module;define def-ident [realT metaV realV])] + (wrap [])) - tags - (&module;declare-tags tags (macro;export? metaV) (:! Type valueV))) - (wrap [])) - #let [_ (log! (format "DEF " (%ident def-ident)))]] - (commonT;record-artifact (format bytecode-name ".class") bytecode))) + _ + (do @ + [#let [normal-name (format (&;normalize-name def-name) (%n (text/hash def-name))) + bytecode-name (format current-module "/" normal-name) + class-name (format (text;replace-all "/" "." current-module) "." normal-name) + bytecode ($d;class #$;V1.6 + #$;Public $;finalC + bytecode-name + (list) ["java.lang.Object" (list)] + (list) + (|>. ($d;field #$;Public ($;++F $;finalF $;staticF) commonT;value-field commonT;$Object) + ($d;method #$;Public $;staticM "<clinit>" ($t;method (list) #;None (list)) + (|>. valueI + ($i;PUTSTATIC bytecode-name commonT;value-field commonT;$Object) + $i;RETURN))))] + _ (commonT;store-class class-name bytecode) + class (commonT;load-class class-name) + valueV (: (Meta Top) + (case (do e;Monad<Error> + [field (Class.getField [commonT;value-field] class)] + (Field.get [#;None] field)) + (#e;Success #;None) + (&;throw Invalid-Definition-Value (%ident def-ident)) + + (#e;Success (#;Some valueV)) + (wrap valueV) + + (#e;Error error) + (&;throw Cannot-Evaluate-Definition + (format "Definition: " (%ident def-ident) "\n" + "Error:\n" + error)))) + _ (&module;define def-ident [valueT metaV valueV]) + _ (if (macro;type? metaV) + (case (macro;declared-tags metaV) + #;Nil + (wrap []) + + tags + (&module;declare-tags tags (macro;export? metaV) (:! Type valueV))) + (wrap [])) + #let [_ (log! (format "DEF " (%ident def-ident)))]] + (commonT;record-artifact (format bytecode-name ".class") bytecode))))) (def: #export (translate-program program-args programI) (-> Text $;Inst (Meta Unit)) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index bdf0758c3..848350499 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -152,8 +152,7 @@ (def: #hidden (<resolve> name) (-> Ident (Meta Ident)) (do Monad<Meta> - [name (macro;normalize name) - [_ annotations _] (macro;find-def name)] + [[_ annotations _] (macro;find-def name)] (case (macro;get-tag-ann (ident-for <tag>) annotations) (#;Some actor-name) (wrap actor-name) diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux index 1260c758f..2837d6177 100644 --- a/stdlib/source/lux/concurrency/atom.lux +++ b/stdlib/source/lux/concurrency/atom.lux @@ -11,7 +11,7 @@ (All [a] (-> a (Atom a))) ("lux atom new" value)) -(def: #export (get atom) +(def: #export (read atom) (All [a] (-> (Atom a) (IO a))) (io ("lux atom get" atom))) @@ -34,6 +34,6 @@ [] (io;run (update f atom)))))) -(def: #export (set value atom) +(def: #export (write value atom) (All [a] (-> a (Atom a) (IO Unit))) (update (function;const value) atom)) diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index 115f60dc1..78cdbecce 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -40,7 +40,7 @@ (def: #export (poll promise) {#;doc "Polls a Promise's value."} (All [a] (-> (Promise a) (Maybe a))) - (|> (atom;get promise) + (|> (atom;read promise) io;run (get@ #value))) @@ -58,7 +58,7 @@ {#;doc "Sets an Promise's value if it has not been done yet."} (All [a] (-> a (Promise a) (IO Bool))) (do Monad<IO> - [old (atom;get promise)] + [old (atom;read promise)] (case (get@ #value old) (#;Some _) (wrap false) @@ -76,7 +76,7 @@ (def: (await f promise) (All [a] (-> (-> a (IO Unit)) (Promise a) Unit)) - (let [old (io;run (atom;get promise))] + (let [old (io;run (atom;read promise))] (case (get@ #value old) (#;Some value) (io;run (f value)) diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index 7886dda36..1fee00b7e 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -1,23 +1,22 @@ (;module: lux - (lux (control ["F" functor] - ["A" applicative] - ["M" monad #+ do Monad]) + (lux (control [functor #+ Functor] + [applicative #+ Applicative] + [monad #+ do Monad]) [io #- run] - (data (coll [list "L/" Functor<List> Fold<List>] - [dict #+ Dict] - ["Q" queue]) + (data (coll [list "list/" Functor<List> Fold<List>] + [dict #+ Dict]) [product] [text] maybe - [number "Nat/" Codec<Text,Nat>] + [number "nat/" Codec<Text,Nat>] text/format) [macro] (macro [code] ["s" syntax #+ syntax: Syntax]) (concurrency [atom #+ Atom atom] ["P" promise] - [frp]) + [frp "frp/" Functor<Channel>]) )) (type: (Var-State a) @@ -48,7 +47,7 @@ (def: raw-read (All [a] (-> (Var a) a)) - (|>. atom;get io;run (get@ #value))) + (|>. atom;read io;run (get@ #value))) (def: (find-var-value var tx) (All [a] (-> (Var a) Tx (Maybe a))) @@ -76,7 +75,7 @@ {#;doc "Reads var immediately, without going through a transaction."} (All [a] (-> (Var a) (IO a))) (|> var - atom;get + atom;read (:: Functor<IO> map (get@ #value)))) (def: (update-tx-value var value tx) @@ -112,7 +111,7 @@ {#;doc "Writes value to var immediately, without going through a transaction."} (All [a] (-> a (Var a) (IO Unit))) (do Monad<IO> - [old (atom;get var) + [old (atom;read var) #let [old-value (get@ #value old) new (set@ #value new-value old)] succeeded? (atom;compare-and-swap old new var)] @@ -121,7 +120,7 @@ [_ (|> old (get@ #observers) dict;values - (M;map @ (function [f] (f new-value))))] + (monad;map @ (function [f] (f new-value))))] (wrap [])) (write! new-value var)))) @@ -143,26 +142,26 @@ (write! tail' channel-var)))] (do Monad<IO> [_ (atom;update (function [[value observers]] - (let [label (Nat/encode (L/fold (function [key base] - (case (Nat/decode key) - (#;Left _) - base - - (#;Right key-num) - (n.max key-num base))) - +0 - (dict;keys observers)))] + (let [label (nat/encode (list/fold (function [key base] + (case (nat/decode key) + (#;Left _) + base + + (#;Right key-num) + (n.max key-num base))) + +0 + (dict;keys observers)))] [value (dict;put label (observer label) observers)])) target)] (wrap head)))) -(struct: #export _ (F;Functor STM) +(struct: #export _ (Functor STM) (def: (map f fa) (function [tx] (let [[tx' a] (fa tx)] [tx' (f a)])))) -(struct: #export _ (A;Applicative STM) +(struct: #export _ (Applicative STM) (def: functor Functor<STM>) (def: (wrap a) @@ -186,7 +185,7 @@ {#;doc "Will update a Var's value, and return a tuple with the old and the new values."} (All [a] (-> (-> a a) (Var a) (IO [a a]))) (io (loop [_ []] - (let [(^@ state [value observers]) (io;run (atom;get var)) + (let [(^@ state [value observers]) (io;run (atom;read var)) value' (f value)] (if (io;run (atom;compare-and-swap state [value' observers] @@ -225,31 +224,18 @@ (Atom Bool) (atom false)) -(def: (process-commit commits) - (-> (frp;Channel [(STM Unit) (P;Promise Unit)]) - (P;Promise Unit)) - (do P;Monad<Promise> - [?head+tail commits] - (case ?head+tail - (#;Cons [stm-proc output] tail) - (do @ - [#let [[finished-tx value] (stm-proc fresh-tx)]] - (exec (if (can-commit? finished-tx) - (exec (L/map commit-var finished-tx) - (io;run (P;resolve value output)) - []) - (exec (io;run (write! [stm-proc output] pending-commits)) - [])) - (process-commit tail))) - - #;Nil - (undefined) - ))) +(def: (process-commit [stm-proc output]) + (-> [(STM Unit) (P;Promise Unit)] Top) + (let [[finished-tx value] (stm-proc fresh-tx)] + (if (can-commit? finished-tx) + (exec (list/map commit-var finished-tx) + (io;run (P;resolve value output))) + (io;run (write! [stm-proc output] pending-commits))))) (def: init-processor! (IO Unit) (do Monad<IO> - [flag (atom;get commit-processor-flag)] + [flag (atom;read commit-processor-flag)] (if flag (wrap []) (do @ @@ -257,8 +243,9 @@ (if was-first? (do Monad<IO> [inputs (follow pending-commits)] - (exec (process-commit (:! (frp;Channel [(STM Unit) (P;Promise Unit)]) - inputs)) + (exec (|> inputs + (:! (frp;Channel [(STM Unit) (P;Promise Unit)])) + (frp/map process-commit)) (wrap []))) (wrap []))) ))) diff --git a/stdlib/source/lux/control/eq.lux b/stdlib/source/lux/control/eq.lux index b69292daa..9e372bd58 100644 --- a/stdlib/source/lux/control/eq.lux +++ b/stdlib/source/lux/control/eq.lux @@ -5,13 +5,13 @@ (: (-> a a Bool) =)) -(def: #export (seq left right) +(def: #export (pair left right) (All [l r] (-> (Eq l) (Eq r) (Eq [l r]))) (struct (def: (= [a b] [x y]) (and (:: left = a x) (:: right = b y))))) -(def: #export (alt left right) +(def: #export (either left right) (All [l r] (-> (Eq l) (Eq r) (Eq (| l r)))) (struct (def: (= a|b x|y) (case [a|b x|y] diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index e344c6a0a..86fdde4a4 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -1,10 +1,10 @@ (;module: lux (lux [io] - (control ["F" functor] - ["A" applicative] - monad) - (concurrency ["a" atom]) + (control [functor #+ Functor] + [applicative #+ Applicative] + [monad #+ Monad do]) + (concurrency [atom]) [macro] (macro ["s" syntax #+ syntax:]) (type opaque))) @@ -14,15 +14,15 @@ (def: #hidden (freeze' generator) (All [a] (-> (-> [] a) (Lazy a))) - (let [cache (a;atom (: (Maybe ($ +0)) #;None))] + (let [cache (atom;atom (: (Maybe ($ +0)) #;None))] (@opaque (function [_] - (case (io;run (a;get cache)) + (case (io;run (atom;read cache)) (#;Some value) value _ (let [value (generator [])] - (exec (io;run (a;compare-and-swap _ (#;Some value) cache)) + (exec (io;run (atom;compare-and-swap _ (#;Some value) cache)) value))))))) (def: #export (thaw l-value) @@ -34,11 +34,11 @@ [g!_ (macro;gensym "_")] (wrap (list (` (freeze' (function [(~ g!_)] (~ expr)))))))) -(struct: #export _ (F;Functor Lazy) +(struct: #export _ (Functor Lazy) (def: (map f fa) (freeze (f (thaw fa))))) -(struct: #export _ (A;Applicative Lazy) +(struct: #export _ (Applicative Lazy) (def: functor Functor<Lazy>) (def: (wrap a) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 1298a56d1..12f6d7abf 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1344,7 +1344,7 @@ )) (syntax: #export (object [#let [imports (class-imports *compiler*)]] - [#let [class-vars (list)]] + [class-vars (s;tuple (p;some (type-param^ imports)))] [super (p;default object-super-class (super-class-decl^ imports class-vars))] [interfaces (p;default (list) diff --git a/stdlib/source/lux/lang/syntax.lux b/stdlib/source/lux/lang/syntax.lux index 9fe4939a2..7bc8e8cca 100644 --- a/stdlib/source/lux/lang/syntax.lux +++ b/stdlib/source/lux/lang/syntax.lux @@ -613,7 +613,7 @@ (p;fail (Unrecognized-Input current-module)))) ))))) -(def: #export (parse current-module [where offset source]) +(def: #export (read current-module [where offset source]) (-> Text Source (e;Error [Source Code])) (case (p;run [offset source] (ast current-module where)) (#e;Error error) diff --git a/stdlib/source/lux/lang/type/check.lux b/stdlib/source/lux/lang/type/check.lux index cbf31ac08..086866ddf 100644 --- a/stdlib/source/lux/lang/type/check.lux +++ b/stdlib/source/lux/lang/type/check.lux @@ -458,6 +458,16 @@ [Type Type] [Type Type] (Check (List Assumption))) (case [eFT aFT] + (^or [(#;UnivQ _ _) (#;Ex _)] [(#;UnivQ _ _) (#;Var _)]) + (do Monad<Check> + [eFT' (apply-type! eFT eAT)] + (check' eFT' (#;Apply aAT aFT) assumptions)) + + (^or [(#;Ex _) (#;UnivQ _ _)] [(#;Var _) (#;UnivQ _ _)]) + (do Monad<Check> + [aFT' (apply-type! aFT aAT)] + (check' (#;Apply eAT eFT) aFT' assumptions)) + (^or [(#;Ex _) _] [_ (#;Ex _)]) (do Monad<Check> [assumptions (check' eFT aFT assumptions)] diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index e65e09b58..e3cba7a31 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -1,8 +1,8 @@ (;module: {#;doc "Functions for extracting information from the state of the compiler."} lux - (lux (control ["F" functor] - ["A" applicative] - ["M" monad #+ do Monad]) + (lux (control [functor #+ Functor] + [applicative #+ Applicative] + [monad #+ do Monad]) (data [number] [product] [ident "ident/" Codec<Text,Ident> Eq<Ident>] @@ -15,30 +15,30 @@ ## (type: (Meta a) ## (-> Compiler (e;Error [Compiler a]))) -(struct: #export _ (F;Functor Meta) +(struct: #export _ (Functor Meta) (def: (map f fa) - (function [state] - (case (fa state) + (function [compiler] + (case (fa compiler) (#e;Error msg) (#e;Error msg) - (#e;Success [state' a]) - (#e;Success [state' (f a)]))))) + (#e;Success [compiler' a]) + (#e;Success [compiler' (f a)]))))) -(struct: #export _ (A;Applicative Meta) +(struct: #export _ (Applicative Meta) (def: functor Functor<Meta>) (def: (wrap x) - (function [state] - (#e;Success [state x]))) + (function [compiler] + (#e;Success [compiler x]))) (def: (apply ff fa) - (function [state] - (case (ff state) - (#e;Success [state' f]) - (case (fa state') - (#e;Success [state'' a]) - (#e;Success [state'' (f a)]) + (function [compiler] + (case (ff compiler) + (#e;Success [compiler' f]) + (case (fa compiler') + (#e;Success [compiler'' a]) + (#e;Success [compiler'' (f a)]) (#e;Error msg) (#e;Error msg)) @@ -50,13 +50,13 @@ (def: applicative Applicative<Meta>) (def: (join mma) - (function [state] - (case (mma state) + (function [compiler] + (case (mma compiler) (#e;Error msg) (#e;Error msg) - (#e;Success [state' ma]) - (ma state'))))) + (#e;Success [compiler' ma]) + (ma compiler'))))) (def: (get k plist) (All [a] @@ -111,20 +111,20 @@ (def: #export (find-module name) (-> Text (Meta Module)) - (function [state] - (case (get name (get@ #;modules state)) + (function [compiler] + (case (get name (get@ #;modules compiler)) (#;Some module) - (#e;Success [state module]) + (#e;Success [compiler module]) _ (#e;Error ($_ text/compose "Unknown module: " name))))) (def: #export current-module-name (Meta Text) - (function [state] - (case (get@ #;current-module state) + (function [compiler] + (case (get@ #;current-module compiler) (#;Some current-module) - (#e;Success [state current-module]) + (#e;Success [compiler current-module]) _ (#e;Error "No current module.") @@ -183,7 +183,7 @@ (def: #export (get-doc anns) {#;doc "Looks-up a definition's documentation."} (-> Code (Maybe Text)) - (get-text-ann ["lux" "doc"] anns)) + (get-text-ann (ident-for #;doc) anns)) (def: #export (flag-set? flag-name anns) {#;doc "Finds out whether an annotation-as-a-flag is set (has value 'true')."} @@ -205,6 +205,15 @@ [sig? #;sig? "a signature"] ) +(def: #export (aliased? annotations) + (-> Code Bool) + (case (get-symbol-ann (ident-for #;alias) annotations) + (#;Some _) + true + + #;None + false)) + (do-template [<name> <tag> <type>] [(def: (<name> input) (-> Code (Maybe <type>)) @@ -227,7 +236,7 @@ (do maybe;Monad<Maybe> [_args (get-ann (ident-for <tag>) anns) args (parse-tuple _args)] - (M;map @ parse-text args))))] + (monad;map @ parse-text args))))] [func-args #;func-args "Looks up the arguments of a function."] [type-args #;type-args "Looks up the arguments of a parameterized type."] @@ -243,22 +252,13 @@ (if (and (macro? def-anns) (or (export? def-anns) (text/= module this-module))) (#;Some (:! Macro def-value)) - (case (get-symbol-ann ["lux" "alias"] def-anns) + (case (get-symbol-ann (ident-for #;alias) def-anns) (#;Some [r-module r-name]) (find-macro' modules this-module r-module r-name) _ #;None)))) -(def: #export (find-macro ident) - (-> Ident (Meta (Maybe Macro))) - (do Monad<Meta> - [this-module current-module-name] - (let [[module name] ident] - (: (Meta (Maybe Macro)) - (function [state] - (#e;Success [state (find-macro' (get@ #;modules state) this-module module name)])))))) - (def: #export (normalize ident) {#;doc "If given an identifier without a module prefix, gives it the current module's name as prefix. @@ -273,6 +273,16 @@ _ (:: Monad<Meta> wrap ident))) +(def: #export (find-macro ident) + (-> Ident (Meta (Maybe Macro))) + (do Monad<Meta> + [ident (normalize ident) + this-module current-module-name] + (let [[module name] ident] + (: (Meta (Maybe Macro)) + (function [compiler] + (#e;Success [compiler (find-macro' (get@ #;modules compiler) this-module module name)])))))) + (def: #export (expand-once syntax) {#;doc "Given code that requires applying a macro, does it once and returns the result. @@ -281,8 +291,7 @@ (case syntax [_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))] (do Monad<Meta> - [name' (normalize name) - ?macro (find-macro name')] + [?macro (find-macro name)] (case ?macro (#;Some macro) (macro args) @@ -301,13 +310,12 @@ (case syntax [_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))] (do Monad<Meta> - [name' (normalize name) - ?macro (find-macro name')] + [?macro (find-macro name)] (case ?macro (#;Some macro) (do Monad<Meta> [expansion (macro args) - expansion' (M;map Monad<Meta> expand expansion)] + expansion' (monad;map Monad<Meta> expand expansion)] (wrap (list/join expansion'))) #;None @@ -322,29 +330,28 @@ (case syntax [_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))] (do Monad<Meta> - [name' (normalize name) - ?macro (find-macro name')] + [?macro (find-macro name)] (case ?macro (#;Some macro) (do Monad<Meta> [expansion (macro args) - expansion' (M;map Monad<Meta> expand-all expansion)] + expansion' (monad;map Monad<Meta> expand-all expansion)] (wrap (list/join expansion'))) #;None (do Monad<Meta> - [parts' (M;map Monad<Meta> expand-all (list& (code;symbol name) args))] + [parts' (monad;map Monad<Meta> expand-all (list& (code;symbol name) args))] (wrap (list (code;form (list/join parts'))))))) [_ (#;Form (#;Cons [harg targs]))] (do Monad<Meta> [harg+ (expand-all harg) - targs+ (M;map Monad<Meta> expand-all targs)] + targs+ (monad;map Monad<Meta> expand-all targs)] (wrap (list (code;form (list/compose harg+ (list/join (: (List (List Code)) targs+))))))) [_ (#;Tuple members)] (do Monad<Meta> - [members' (M;map Monad<Meta> expand-all members)] + [members' (monad;map Monad<Meta> expand-all members)] (wrap (list (code;tuple (list/join members'))))) _ @@ -355,9 +362,9 @@ A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."} (-> Text (Meta Code)) - (function [state] - (#e;Success [(update@ #;seed n.inc state) - (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])]))) + (function [compiler] + (#e;Success [(update@ #;seed n.inc compiler) + (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed compiler)))])]))) (def: (get-local-symbol ast) (-> Code (Meta Text)) @@ -381,7 +388,7 @@ (case tokens (^ (list [_ (#;Tuple symbols)] body)) (do Monad<Meta> - [symbol-names (M;map @ get-local-symbol symbols) + [symbol-names (monad;map @ get-local-symbol symbols) #let [symbol-defs (list/join (list/map (: (-> Text (List Code)) (function [name] (list (code;symbol ["" name]) (` (gensym (~ (code;text name))))))) symbol-names))]] @@ -406,13 +413,13 @@ (def: #export (module-exists? module) (-> Text (Meta Bool)) - (function [state] - (#e;Success [state (case (get module (get@ #;modules state)) - (#;Some _) - true - - #;None - false)]))) + (function [compiler] + (#e;Success [compiler (case (get module (get@ #;modules compiler)) + (#;Some _) + true + + #;None + false)]))) (def: (try-both f x1 x2) (All [a b] @@ -424,7 +431,7 @@ (def: #export (find-var-type name) {#;doc "Looks-up the type of a local variable somewhere in the environment."} (-> Text (Meta Type)) - (function [state] + (function [compiler] (let [test (: (-> [Text [Type Top]] Bool) (|>. product;left (text/= name)))] (case (do maybe;Monad<Maybe> @@ -433,7 +440,7 @@ (get@ [#;locals #;mappings] env))) (list;any? test (: (List [Text [Type Top]]) (get@ [#;captured #;mappings] env))))) - (get@ #;scopes state)) + (get@ #;scopes compiler)) [_ [type _]] (try-both (list;find test) (: (List [Text [Type Top]]) (get@ [#;locals #;mappings] scope)) @@ -441,25 +448,60 @@ (get@ [#;captured #;mappings] scope)))] (wrap type)) (#;Some var-type) - (#e;Success [state var-type]) + (#e;Success [compiler var-type]) #;None (#e;Error ($_ text/compose "Unknown variable: " name)))))) +(def: #export (canonical name) + (-> Ident (Meta Ident)) + (case name + ["" _name] + (do Monad<Meta> + [this-module current-module-name] + (wrap [this-module _name])) + + [_module _name] + (do Monad<Meta> + [this-module-name current-module-name + this-module (find-module this-module-name)] + (case (list;find (|>. product;left (text/= _module)) + (get@ #;module-aliases this-module)) + (#;Some [alias real]) + (wrap [real _name]) + + _ + (wrap name))) + )) + (def: #export (find-def name) {#;doc "Looks-up a definition's whole data in the available modules (including the current one)."} (-> Ident (Meta Def)) - (function [state] - (case (: (Maybe Def) - (do maybe;Monad<Maybe> - [#let [[v-prefix v-name] name] - (^slots [#;defs]) (get v-prefix (get@ #;modules state))] - (get v-name defs))) - (#;Some _anns) - (#e;Success [state _anns]) + (do Monad<Meta> + [name (canonical name)] + (function [compiler] + (case (: (Maybe Def) + (do maybe;Monad<Maybe> + [#let [[v-prefix v-name] name] + (^slots [#;defs]) (get v-prefix (get@ #;modules compiler))] + (get v-name defs))) + (#;Some definition) + (#e;Success [compiler definition]) - _ - (#e;Error ($_ text/compose "Unknown definition: " (ident/encode name)))))) + _ + (let [current-module (|> compiler (get@ #;current-module) (maybe;default "???"))] + (#e;Error ($_ text/compose + "Unknown definition: " (ident/encode name) "\n" + " Current module: " current-module "\n" + (case (get current-module (get@ #;modules compiler)) + (#;Some this-module) + ($_ text/compose + " Imports: " (|> this-module (get@ #;imports) (text;join-with ", ")) "\n" + " Aliases: " (|> this-module (get@ #;module-aliases) (list/map (function [[alias real]] ($_ text/compose alias " => " real))) (text;join-with ", ")) "\n") + + _ + "") + " All Known modules: " (|> compiler (get@ #;modules) (list/map product;left) (text;join-with ", ")) "\n"))))))) (def: #export (find-def-type name) {#;doc "Looks-up a definition's type in the available modules (including the current one)."} @@ -473,10 +515,13 @@ (-> Ident (Meta Type)) (do Monad<Meta> [#let [[_ _name] name]] - (either (find-var-type _name) - (do @ - [name (normalize name)] - (find-def-type name))))) + (case name + ["" _name] + (either (find-var-type _name) + (find-def-type name)) + + _ + (find-def-type name)))) (def: #export (find-type-def name) {#;doc "Finds the value of a type definition (such as Int, Top or Compiler)."} @@ -488,10 +533,10 @@ (def: #export (defs module-name) {#;doc "The entire list of definitions in a module (including the unexported/private ones)."} (-> Text (Meta (List [Text Def]))) - (function [state] - (case (get module-name (get@ #;modules state)) + (function [compiler] + (case (get module-name (get@ #;modules compiler)) #;None (#e;Error ($_ text/compose "Unknown module: " module-name)) - (#;Some module) (#e;Success [state (get@ #;defs module)]) + (#;Some module) (#e;Success [compiler (get@ #;defs module)]) ))) (def: #export (exports module-name) @@ -507,10 +552,10 @@ (def: #export modules {#;doc "All the available modules (including the current one)."} (Meta (List [Text Module])) - (function [state] - (|> state + (function [compiler] + (|> compiler (get@ #;modules) - [state] + [compiler] #e;Success))) (def: #export (tags-of type-name) @@ -529,16 +574,16 @@ (def: #export cursor {#;doc "The cursor of the current expression being analyzed."} (Meta Cursor) - (function [state] - (#e;Success [state (get@ #;cursor state)]))) + (function [compiler] + (#e;Success [compiler (get@ #;cursor compiler)]))) (def: #export expected-type {#;doc "The expected type of the current expression being analyzed."} (Meta Type) - (function [state] - (case (get@ #;expected state) + (function [compiler] + (case (get@ #;expected compiler) (#;Some type) - (#e;Success [state type]) + (#e;Success [compiler type]) #;None (#e;Error "Not expecting any type.")))) @@ -583,13 +628,13 @@ (def: #export locals {#;doc "All the local variables currently in scope, separated in different scopes."} (Meta (List (List [Text Type]))) - (function [state] - (case (list;inits (get@ #;scopes state)) + (function [compiler] + (case (list;inits (get@ #;scopes compiler)) #;None (#e;Error "No local environment") (#;Some scopes) - (#e;Success [state + (#e;Success [compiler (list/map (|>. (get@ [#;locals #;mappings]) (list/map (function [[name [type _]]] [name type]))) @@ -599,8 +644,7 @@ {#;doc "Given an aliased definition's name, returns the original definition being referenced."} (-> Ident (Meta Ident)) (do Monad<Meta> - [def-name (normalize def-name) - [_ def-anns _] (find-def def-name)] + [[_ def-anns _] (find-def def-name)] (case (get-symbol-ann (ident-for #;alias) def-anns) (#;Some real-def-name) (wrap real-def-name) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index d296a9a2e..f8cfa9871 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -1,6 +1,6 @@ (;module: {#;doc "Tools for unit & property-based/generative testing."} lux - (lux [macro #+ Monad<Meta> with-gensyms] + (lux [macro #+ with-gensyms] (macro ["s" syntax #+ syntax: Syntax] [code]) (control [monad #+ do Monad] @@ -12,7 +12,7 @@ [text] text/format ["e" error]) - [io #- run] + [io #+ IO io] (time [instant] [duration]) ["r" math/random])) @@ -199,7 +199,7 @@ (def: (exported-tests module-name) (-> Text (Meta (List [Text Text Text]))) - (do Monad<Meta> + (do macro;Monad<Meta> [defs (macro;exports module-name)] (wrap (|> defs (list/map (function [[def-name [_ def-anns _]]] diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux index fc68dcdae..a7945b41a 100644 --- a/stdlib/source/lux/type/object.lux +++ b/stdlib/source/lux/type/object.lux @@ -143,8 +143,7 @@ [(def: (<name> name) (-> Ident (Meta [Ident (List Ident)])) (do Monad<Meta> - [name (macro;normalize name) - [_ annotations _] (macro;find-def name)] + [[_ annotations _] (macro;find-def name)] (case [(macro;get-tag-ann (ident-for <name-tag>) annotations) (macro;get-tag-ann (ident-for <parent-tag>) annotations)] [(#;Some real-name) (#;Some parent)] diff --git a/stdlib/test/test/lux/concurrency/atom.lux b/stdlib/test/test/lux/concurrency/atom.lux index 90c1c07d2..039546436 100644 --- a/stdlib/test/test/lux/concurrency/atom.lux +++ b/stdlib/test/test/lux/concurrency/atom.lux @@ -18,17 +18,17 @@ #let [box (&;atom value)]] ($_ seq (test "Can obtain the value of an atom." - (n.= value (io;run (&;get box)))) + (n.= value (io;run (&;read box)))) (test "Can swap the value of an atom." (and (io;run (&;compare-and-swap value swap-value box)) - (n.= swap-value (io;run (&;get box))))) + (n.= swap-value (io;run (&;read box))))) (test "Can update the value of an atom." (exec (io;run (&;update n.inc box)) - (n.= (n.inc swap-value) (io;run (&;get box))))) + (n.= (n.inc swap-value) (io;run (&;read box))))) (test "Can immediately set the value of an atom." - (exec (io;run (&;set set-value box)) - (n.= set-value (io;run (&;get box))))) + (exec (io;run (&;write set-value box)) + (n.= set-value (io;run (&;read box))))) )))) diff --git a/stdlib/test/test/lux/data/coll/dict.lux b/stdlib/test/test/lux/data/coll/dict.lux index f2e47615a..536ad8450 100644 --- a/stdlib/test/test/lux/data/coll/dict.lux +++ b/stdlib/test/test/lux/data/coll/dict.lux @@ -8,7 +8,7 @@ [number] [maybe] (coll ["&" dict] - [list "L/" Fold<List> Functor<List>])) + [list "list/" Fold<List> Functor<List>])) ["r" math/random]) lux/test) @@ -30,7 +30,7 @@ (not (&;empty? dict)))) (test "The functions 'entries', 'keys' and 'values' should be synchronized." - (:: (list;Eq<List> (eq;seq number;Eq<Nat> number;Eq<Nat>)) = + (:: (list;Eq<List> (eq;pair number;Eq<Nat> number;Eq<Nat>)) = (&;entries dict) (list;zip2 (&;keys dict) (&;values dict)))) @@ -99,7 +99,7 @@ (test "If you merge, and the second dict has overlapping keys, it should overwrite yours." (let [dict' (|> dict &;entries - (L/map (function [[k v]] [k (n.inc v)])) + (list/map (function [[k v]] [k (n.inc v)])) (&;from-list number;Hash<Nat>)) (^open) (&;Eq<Dict> number;Eq<Nat>)] (= dict' (&;merge dict' dict)))) diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index d41c587c8..070457799 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -11,6 +11,8 @@ ["r" math/random]) lux/test) +(&;import (java.util.concurrent.Callable a)) + (&;import java.lang.Exception (new [String])) @@ -44,11 +46,17 @@ ) (def: test-runnable - (object [Runnable] + (object [] [Runnable] [] (Runnable [] (run) void []))) +(def: test-callable + (object [a] [(Callable a)] + [] + (Callable [] (call) a + (undefined)))) + (interface: TestInterface ([] foo [boolean String] void #throws [Exception])) diff --git a/stdlib/test/test/lux/lang/syntax.lux b/stdlib/test/test/lux/lang/syntax.lux index 154e18a91..3eb9bfc02 100644 --- a/stdlib/test/test/lux/lang/syntax.lux +++ b/stdlib/test/test/lux/lang/syntax.lux @@ -80,20 +80,20 @@ other code^] ($_ seq (test "Can parse Lux code." - (case (&;parse "" [default-cursor +0 (code;to-text sample)]) + (case (&;read "" [default-cursor +0 (code;to-text sample)]) (#e;Error error) false (#e;Success [_ parsed]) (:: code;Eq<Code> = parsed sample))) (test "Can parse Lux multiple code nodes." - (case (&;parse "" [default-cursor +0 (format (code;to-text sample) " " - (code;to-text other))]) + (case (&;read "" [default-cursor +0 (format (code;to-text sample) " " + (code;to-text other))]) (#e;Error error) false (#e;Success [remaining =sample]) - (case (&;parse "" remaining) + (case (&;read "" remaining) (#e;Error error) false @@ -114,11 +114,11 @@ signed? r;bool #let [expected (|> numerator (f./ denominator) (f.* (if signed? -1.0 1.0)))]] (test "Can parse frac ratio syntax." - (case (&;parse "" [default-cursor +0 - (format (if signed? "-" "") - (%i (frac-to-int numerator)) - "/" - (%i (frac-to-int denominator)))]) + (case (&;read "" [default-cursor +0 + (format (if signed? "-" "") + (%i (frac-to-int numerator)) + "/" + (%i (frac-to-int denominator)))]) (#e;Success [_ [_ (#;Frac actual)]]) (f.= expected actual) @@ -131,8 +131,8 @@ (do @ [expected (|> r;nat (:: @ map (n.% +1_000)))] (test "Can parse nat char syntax." - (case (&;parse "" [default-cursor +0 - (format "#" (%t (text;from-code expected)) "")]) + (case (&;read "" [default-cursor +0 + (format "#" (%t (text;from-code expected)) "")]) (#e;Success [_ [_ (#;Nat actual)]]) (n.= expected actual) @@ -181,8 +181,8 @@ (let [bad-match (format (text;from-code x) "\n" (text;from-code y) "\n" (text;from-code z))] - (case (&;parse "" [default-cursor +0 - (format "\"" bad-match "\"")]) + (case (&;read "" [default-cursor +0 + (format "\"" bad-match "\"")]) (#e;Error error) true @@ -195,9 +195,9 @@ good-output (format (text;from-code x) "\n" (text;from-code y) "\n" (text;from-code z))] - (case (&;parse "" [(|> default-cursor (update@ #;column (n.+ (n.dec offset-size)))) - +0 - (format "\"" good-input "\"")]) + (case (&;read "" [(|> default-cursor (update@ #;column (n.+ (n.dec offset-size)))) + +0 + (format "\"" good-input "\"")]) (#e;Error error) false @@ -206,25 +206,25 @@ parsed (code;text good-output))))) (test "Can handle comments." - (case (&;parse "" [default-cursor +0 - (format comment (code;to-text sample))]) + (case (&;read "" [default-cursor +0 + (format comment (code;to-text sample))]) (#e;Error error) false (#e;Success [_ parsed]) (:: code;Eq<Code> = parsed sample))) (test "Will reject unbalanced multi-line comments." - (and (case (&;parse "" [default-cursor +0 - (format "#(" "#(" unbalanced-comment ")#" - (code;to-text sample))]) + (and (case (&;read "" [default-cursor +0 + (format "#(" "#(" unbalanced-comment ")#" + (code;to-text sample))]) (#e;Error error) true (#e;Success [_ parsed]) false) - (case (&;parse "" [default-cursor +0 - (format "#(" unbalanced-comment ")#" ")#" - (code;to-text sample))]) + (case (&;read "" [default-cursor +0 + (format "#(" unbalanced-comment ")#" ")#" + (code;to-text sample))]) (#e;Error error) true |