From 32db706bd8df4901321fce9f87ce06847d2ce4de Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 8 Aug 2018 19:05:45 -0400 Subject: Small fixes. --- new-luxc/source/luxc/lang/translation/jvm.lux | 2 +- stdlib/source/lux/compiler/default.lux | 10 +- .../lux/compiler/default/phase/extension.lux | 2 +- stdlib/source/lux/compiler/default/syntax.lux | 159 +++++++++++---------- stdlib/source/lux/compiler/meta/io/context.lux | 6 +- .../lux/data/collection/dictionary/plist.lux | 14 +- stdlib/source/lux/data/text/format.lux | 6 + stdlib/source/lux/macro/code.lux | 8 +- 8 files changed, 119 insertions(+), 88 deletions(-) diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index 3fd3d389b..dafd7d68c 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -103,7 +103,7 @@ (-> Store ClassLoader) (object [] ClassLoader [] [] - (ClassLoader (findClass [class-name String]) Class + (ClassLoader (findClass {class-name String}) Class (case (fetch-bytecode class-name store) (#.Some bytecode) (case (define-class class-name bytecode (:coerce ClassLoader _jvm_this)) diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux index c85df80c1..e53e08142 100644 --- a/stdlib/source/lux/compiler/default.lux +++ b/stdlib/source/lux/compiler/default.lux @@ -91,11 +91,11 @@ _ (analysis.set-current-module module-name)] (analysis.set-source-code (init.source (get@ #name source) (get@ #code source)))))) - (def: (end-module-compilation module-name) + (def: end-module-compilation (All [anchor expression statement] (-> Text )) - (statement.lift-analysis! - (module.set-compiled module-name))) + (|>> module.set-compiled + statement.lift-analysis!)) (def: (loop-module-compilation module-name) (All [anchor expression statement] @@ -184,6 +184,6 @@ _ (compile-module platform configuration ..prelude compiler) _ (compile-module platform configuration program compiler) ## _ (cache/io.clean target ...) - #let [_ (log! "Compilation complete!")]] - (wrap []))) + ] + (wrap (log! "Compilation complete!")))) ) diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux index 15960083b..3783b741a 100644 --- a/stdlib/source/lux/compiler/default/phase/extension.lux +++ b/stdlib/source/lux/compiler/default/phase/extension.lux @@ -114,4 +114,4 @@ (#error.Error error) (#error.Success [state' output]) - (#error.Success [[bundle state] output])))) + (#error.Success [[bundle state'] output])))) diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 7faa5a4ea..09db624df 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -25,7 +25,7 @@ ## (file-name, line, column) to keep track of their provenance and ## location, which is helpful for documentation and debugging. (.module: - [lux (#- nat int rev) + [lux (#- nat int rev true false) [control monad ["p" parser ("parser/." Monad)] @@ -36,11 +36,12 @@ ["." product] ["." maybe] ["." text - ["l" lexer] + ["l" lexer (#+ Lexer)] format] [collection ["." row (#+ Row)] - ["." dictionary (#+ Dictionary)]]]]) + ["." dictionary (#+ Dictionary)]]] + ["." function]]) (type: #export Aliases (Dictionary Text Text)) (def: #export no-aliases Aliases (dictionary.new text.Hash)) @@ -54,7 +55,7 @@ ## It operates recursively in order to produce the longest continuous ## chunk of white-space. (def: (space^ where) - (-> Cursor (l.Lexer [Cursor Text])) + (-> Cursor (Lexer [Cursor Text])) (p.either (do p.Monad [content (l.many (l.one-of white-space))] (wrap [(update@ #.column (n/+ (text.size content)) where) @@ -72,7 +73,7 @@ ## Single-line comments can start anywhere, but only go up to the ## next new-line. (def: (single-line-comment^ where) - (-> Cursor (l.Lexer [Cursor Text])) + (-> Cursor (Lexer [Cursor Text])) (do p.Monad [_ (l.this "##") comment (l.some (l.none-of new-line)) @@ -85,7 +86,7 @@ ## This is just a helper parser to find text which doesn't run into ## any special character sequences for multi-line comments. (def: comment-bound^ - (l.Lexer Any) + (Lexer Any) ($_ p.either (l.this new-line) (l.this ")#") @@ -97,7 +98,7 @@ ## That is, any nested comment must have matched delimiters. ## Unbalanced comments ought to be rejected as invalid code. (def: (multi-line-comment^ where) - (-> Cursor (l.Lexer [Cursor Text])) + (-> Cursor (Lexer [Cursor Text])) (do p.Monad [_ (l.this "#(")] (loop [comment "" @@ -141,7 +142,7 @@ ## from being used in any situation (alternatively, forcing one type ## of comment to be the only usable one). (def: (comment^ where) - (-> Cursor (l.Lexer [Cursor Text])) + (-> Cursor (Lexer [Cursor Text])) (p.either (single-line-comment^ where) (multi-line-comment^ where))) @@ -150,7 +151,7 @@ ## Left-padding is assumed to be either white-space or a comment. ## The cursor gets updated, but the padding gets ignored. (def: (left-padding^ where) - (-> Cursor (l.Lexer Cursor)) + (-> Cursor (Lexer Cursor)) ($_ p.either (do p.Monad [[where comment] (comment^ where)] @@ -166,7 +167,7 @@ ## and 4 characters long (e.g. \u12aB). ## Escaped characters may show up in Char and Text literals. (def: escaped-char^ - (l.Lexer [Nat Text]) + (Lexer [Nat Text]) (p.after (l.this "\\") (do p.Monad [code l.any] @@ -199,12 +200,12 @@ ## specific shapes and then use decoders already present in the ## standard library to actually produce the values from the literals. (def: rich-digit - (l.Lexer Text) + (Lexer Text) (p.either l.decimal (p.after (l.this "_") (parser/wrap "")))) (def: rich-digits^ - (l.Lexer Text) + (Lexer Text) (l.and l.decimal (l.some rich-digit))) @@ -212,7 +213,7 @@ (do-template [ ] [(def: #export ( where) - (-> Cursor (l.Lexer [Cursor Code])) + (-> Cursor (Lexer [Cursor Code])) (do p.Monad [chunk ] (case (:: decode chunk) @@ -234,10 +235,10 @@ ) (def: (nat-char where) - (-> Cursor (l.Lexer [Cursor Code])) + (-> Cursor (Lexer [Cursor Code])) (do p.Monad [_ (l.this "#\"") - [where' char] (: (l.Lexer [Cursor Text]) + [where' char] (: (Lexer [Cursor Text]) ($_ p.either ## Normal text characters. (do @ @@ -259,7 +260,7 @@ [where (#.Nat char)]]))) (def: (normal-nat where) - (-> Cursor (l.Lexer [Cursor Code])) + (-> Cursor (Lexer [Cursor Code])) (do p.Monad [chunk rich-digits^] (case (:: number.Codec decode chunk) @@ -271,12 +272,12 @@ [where (#.Nat value)]])))) (def: #export (nat where) - (-> Cursor (l.Lexer [Cursor Code])) + (-> Cursor (Lexer [Cursor Code])) (p.either (normal-nat where) (nat-char where))) (def: (normal-frac where) - (-> Cursor (l.Lexer [Cursor Code])) + (-> Cursor (Lexer [Cursor Code])) (do p.Monad [chunk ($_ l.and sign^ @@ -297,14 +298,14 @@ [where (#.Frac value)]])))) (def: frac-ratio-fragment - (l.Lexer Frac) + (Lexer Frac) (<| (p.codec number.Codec) (:: p.Monad map (function (_ digits) (format digits ".0"))) rich-digits^)) (def: (ratio-frac where) - (-> Cursor (l.Lexer [Cursor Code])) + (-> Cursor (Lexer [Cursor Code])) (do p.Monad [chunk ($_ l.and (p.default "" (l.one-of "-")) @@ -326,14 +327,14 @@ [where (#.Frac value)]]))) (def: #export (frac where) - (-> Cursor (l.Lexer [Cursor Code])) + (-> Cursor (Lexer [Cursor Code])) (p.either (normal-frac where) (ratio-frac where))) ## This parser looks so complex because text in Lux can be multi-line ## and there are rules regarding how this is handled. (def: #export (text where) - (-> Cursor (l.Lexer [Cursor Code])) + (-> Cursor (Lexer [Cursor Code])) (do p.Monad [## Lux text "is delimited by double-quotes", as usual in most ## programming languages. @@ -346,7 +347,7 @@ ## This helps ensure that the formatting on the text in the ## source-code matches the formatting of the Text value. #let [offset-column (inc (get@ #.column where))] - [where' text-read] (: (l.Lexer [Cursor Text]) + [where' text-read] (: (Lexer [Cursor Text]) ## I must keep track of how much of the ## text body has been read, how far the ## cursor has progressed, and whether I'm @@ -424,8 +425,8 @@ (do-template [ ] [(def: ( where ast) (-> Cursor - (-> Cursor (l.Lexer [Cursor Code])) - (l.Lexer [Cursor Code])) + (-> Cursor (Lexer [Cursor Code])) + (Lexer [Cursor Code])) (do p.Monad [_ (l.this ) [where' elems] (loop [elems (: (Row Code) @@ -463,8 +464,8 @@ ## macros. (def: (record where ast) (-> Cursor - (-> Cursor (l.Lexer [Cursor Code])) - (l.Lexer [Cursor Code])) + (-> Cursor (Lexer [Cursor Code])) + (Lexer [Cursor Code])) (do p.Monad [_ (l.this "{") [where' elems] (loop [elems (: (Row [Code Code]) @@ -506,7 +507,7 @@ ## Additionally, the first character in an name's part cannot be ## a digit, to avoid confusion with regards to numbers. (def: name-part^ - (l.Lexer Text) + (Lexer Text) (do p.Monad [#let [digits "0123456789" delimiters (format "()[]{}#\"" name-separator) @@ -520,7 +521,7 @@ (def: current-module-mark Text (format name-separator name-separator)) (def: (name^ current-module aliases) - (-> Text Aliases (l.Lexer [Name Nat])) + (-> Text Aliases (Lexer [Name Nat])) ($_ p.either ## When an name starts with 2 marks, its module is ## taken to be the current-module being compiled at the moment. @@ -565,64 +566,70 @@ (wrap [["" first-part] (text.size first-part)]))))) -(def: #export (tag current-module aliases where) - (-> Text Aliases Cursor (l.Lexer [Cursor Code])) - (do p.Monad - [[value length] (p.after (l.this "#") - (name^ current-module aliases))] - (wrap [(update@ #.column (|>> ($_ n/+ 1 length)) where) - [where (#.Tag value)]]))) +(do-template [ 
  ]
+  [(def: #export ( current-module aliases where)
+     (-> Text Aliases Cursor (Lexer [Cursor Code]))
+     (do p.Monad
+       [[value length] (<| 
+                           (name^ current-module aliases))]
+       (wrap [(update@ #.column (|>> (n/+ )) where)
+              [where ( value)]])))]
+
+  [tag        (p.after (l.this "#")) #.Tag        (n/+ 1 length)]
+  [identifier (|>)                   #.Identifier length]
+  )
+
+(do-template [ ]
+  [(def: 
+     (Lexer Bit)
+     (:: p.Monad map (function.constant ) (l.this (%b ))))]
 
-(def: #export (identifier current-module aliases where)
-  (-> Text Aliases Cursor (l.Lexer [Cursor Code]))
+  [false #0]
+  [true  #1]
+  )
+
+(def: #export (bit where)
+  (-> Cursor (Lexer [Cursor Code]))
   (do p.Monad
-    [[value length] (name^ current-module aliases)]
-    (wrap [(update@ #.column (|>> (n/+ length)) where)
-           [where (case value
-                    (^template [ ]
-                      ["" ]
-                      (#.Bit ))
-                    (["#0" #0]
-                     ["#1" #1])
-                    
-                    _
-                    (#.Identifier value))]])))
+    [value (p.either ..false ..true)]
+    (wrap [(update@ #.column (|>> (n/+ 2)) where)
+           [where (#.Bit value)]])))
 
 (exception: #export (end-of-file {module Text})
-  module)
+  (ex.report ["Module" (%t module)]))
 
 (exception: #export (unrecognized-input {[file line column] Cursor})
-  (ex.report ["File" file]
+  (ex.report ["File" (%t file)]
              ["Line" (%n line)]
              ["Column" (%n column)]))
 
 (def: (ast current-module aliases)
-  (-> Text Aliases Cursor (l.Lexer [Cursor Code]))
-  (: (-> Cursor (l.Lexer [Cursor Code]))
-     (function (ast' where)
-       (do p.Monad
-         [where (left-padding^ where)]
-         ($_ p.either
-             (form where ast')
-             (tuple where ast')
-             (record where ast')
-             (nat where)
-             (frac where)
-             (int where)
-             (rev where)
-             (identifier current-module aliases where)
-             (tag current-module aliases where)
-             (text where)
-             (do @
-               [end? l.end?]
-               (if end?
-                 (p.fail (ex.construct end-of-file current-module))
-                 (p.fail (ex.construct unrecognized-input where))))
-             )))))
-
-(def: #export (read current-module aliases [where offset source])
+  (-> Text Aliases Cursor (Lexer [Cursor Code]))
+  (function (ast' where)
+    (do p.Monad
+      [where (left-padding^ where)]
+      ($_ p.either
+          (form where ast')
+          (tuple where ast')
+          (record where ast')
+          (identifier current-module aliases where)
+          (tag current-module aliases where)
+          (text where)
+          (nat where)
+          (int where)
+          (frac where)
+          (rev where)
+          (bit where)
+          (do @
+            [end? l.end?]
+            (if end?
+              (p.fail (ex.construct end-of-file current-module))
+              (p.fail (ex.construct unrecognized-input where))))
+          ))))
+
+(def: #export (read current-module aliases [where offset source-code])
   (-> Text Aliases Source (e.Error [Source Code]))
-  (case (p.run [offset source] (ast current-module aliases where))
+  (case (p.run [offset source-code] (ast current-module aliases where))
     (#e.Error error)
     (#e.Error error)
 
diff --git a/stdlib/source/lux/compiler/meta/io/context.lux b/stdlib/source/lux/compiler/meta/io/context.lux
index 615cd8d94..643640698 100644
--- a/stdlib/source/lux/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/compiler/meta/io/context.lux
@@ -23,7 +23,7 @@
       (//.sanitize System)
       (format context (:: System separator))))
 
-(def: host-extension
+(def: partial-host-extension
   Extension
   (`` (for {(~~ (static host.common-lisp)) ".cl"
             (~~ (static host.js))          ".js"
@@ -37,7 +37,7 @@
 
 (def: lux-extension Extension ".lux")
 
-(def: full-extension Extension (format host-extension lux-extension))
+(def: full-host-extension Extension (format partial-host-extension lux-extension))
 
 (do-template []
   [(exception: #export ( {module Module})
@@ -88,7 +88,7 @@
   (let [find-source' (find-source System contexts module)]
     (do (:: System &monad)
       [[path file] (try System
-                        (list (find-source' ..full-extension)
+                        (list (find-source' ..full-host-extension)
                               (find-source' ..lux-extension))
                         ..module-not-found [module])
        binary (:: System read file)]
diff --git a/stdlib/source/lux/data/collection/dictionary/plist.lux b/stdlib/source/lux/data/collection/dictionary/plist.lux
index 8b2bef218..2f4593fac 100644
--- a/stdlib/source/lux/data/collection/dictionary/plist.lux
+++ b/stdlib/source/lux/data/collection/dictionary/plist.lux
@@ -1,7 +1,10 @@
 (.module:
   [lux #*
    [data
-    [text ("text/." Equivalence)]]])
+    ["." product]
+    [text ("text/." Equivalence)]
+    [collection
+     [list ("list/." Functor)]]]])
 
 (type: #export (PList a)
   (List [Text a]))
@@ -17,6 +20,15 @@
       (#.Some v')
       (get key properties'))))
 
+(do-template [  ]
+  [(def: #export 
+     (All [a] (-> (PList a) (List )))
+     (list/map ))]
+
+  [keys   Text product.left]
+  [values a    product.right]
+  )
+
 (def: #export (contains? key properties)
   (All [a] (-> Text (PList a) Bit))
   (case (get key properties)
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index 7f4188154..02c3eaae2 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -59,6 +59,12 @@
   [%date     date.Date         (:: date.Codec encode)]
   )
 
+(def: #export (%cursor [file line column])
+  (Format Cursor)
+  (|> (list (%t file) (%n line) (%n column))
+      (text.join-with ", ")
+      (text.enclose ["[" "]"])))
+
 (def: #export (%mod modular)
   (All [m] (Format (modular.Mod m)))
   (let [[_ modulus] (modular.un-mod modular)]
diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux
index f04503e2f..7e78fe617 100644
--- a/stdlib/source/lux/macro/code.lux
+++ b/stdlib/source/lux/macro/code.lux
@@ -108,7 +108,13 @@
 
     (^template [  ]
       [_ ( members)]
-      ($_ text/compose  (|> members (list/map to-text) (list.interpose " ") (text.join-with "")) ))
+      ($_ text/compose
+          
+          (|> members
+              (list/map to-text)
+              (list.interpose " ")
+              (text.join-with ""))
+          ))
     ([#.Form  "(" ")"]
      [#.Tuple "[" "]"])
 
-- 
cgit v1.2.3