From ede9a0500ed00b5636d5eaf9a5b470f159c97edb Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 8 Aug 2015 17:57:07 -0400
Subject: More refactoring of tags, this time for reader, lexer & parser.
---
src/lux/base.clj | 4 ++++
src/lux/lexer.clj | 53 ++++++++++++++++++++++++++++++++++++-----------------
src/lux/parser.clj | 51 +++++++++++++++++++++++++++++++++++----------------
src/lux/reader.clj | 32 +++++++++++++++++++-------------
4 files changed, 94 insertions(+), 46 deletions(-)
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 532f56695..66b972f94 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -12,6 +12,10 @@
clojure.core.match.array))
;; [Tags]
+(defmacro deftags [prefix & names]
+ `(do ~@(for [name names]
+ `(def ~(symbol (str "$" name)) ~name))))
+
;; List
(def $Nil "lux;Nil")
(def $Cons "lux;Cons")
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 22e1b3de1..e848cc3fd 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -8,10 +8,29 @@
(ns lux.lexer
(:require [clojure.template :refer [do-template]]
- (lux [base :as & :refer [|do return* return fail fail*]]
+ (lux [base :as & :refer [deftags |do return* return fail fail*]]
[reader :as &reader])
[lux.analyser.module :as &module]))
+;; [Tags]
+(deftags ""
+ "White_Space"
+ "Comment"
+ "Bool"
+ "Int"
+ "Real"
+ "Char"
+ "Text"
+ "Symbol"
+ "Tag"
+ "Open_Paren"
+ "Close_Paren"
+ "Open_Bracket"
+ "Close_Bracket"
+ "Open_Brace"
+ "Close_Brace"
+ )
+
;; [Utils]
(defn ^:private escape-char [escaped]
(cond (.equals ^Object escaped "\\t") (return "\t")
@@ -39,12 +58,12 @@
;; [Lexers]
(def ^:private lex-white-space
(|do [[meta white-space] (&reader/read-regex #"^(\s+)")]
- (return (&/V &/$Meta (&/T meta (&/V "White_Space" white-space))))))
+ (return (&/V &/$Meta (&/T meta (&/V $White_Space white-space))))))
(def ^:private lex-single-line-comment
(|do [_ (&reader/read-text "##")
[meta comment] (&reader/read-regex #"^(.*)$")]
- (return (&/V &/$Meta (&/T meta (&/V "Comment" comment))))))
+ (return (&/V &/$Meta (&/T meta (&/V $Comment comment))))))
(defn ^:private lex-multi-line-comment [_]
(|do [_ (&reader/read-text "#(")
@@ -63,7 +82,7 @@
(return (&/T meta (str pre "#(" inner ")#" post))))))
;; :let [_ (prn 'lex-multi-line-comment (str comment ")#"))]
_ (&reader/read-text ")#")]
- (return (&/V &/$Meta (&/T meta (&/V "Comment" comment))))))
+ (return (&/V &/$Meta (&/T meta (&/V $Comment comment))))))
(def ^:private lex-comment
(&/try-all% (&/|list lex-single-line-comment
@@ -74,9 +93,9 @@
(|do [[meta token] (&reader/read-regex <regex>)]
(return (&/V &/$Meta (&/T meta (&/V <tag> token))))))
- ^:private lex-bool "Bool" #"^(true|false)"
- ^:private lex-int "Int" #"^(-?0|-?[1-9][0-9]*)"
- ^:private lex-real "Real" #"^-?(-?0\.[0-9]+|-?[1-9][0-9]*\.[0-9]+)"
+ ^:private lex-bool $Bool #"^(true|false)"
+ ^:private lex-int $Int #"^(-?0|-?[1-9][0-9]*)"
+ ^:private lex-real $Real #"^-?(-?0\.[0-9]+|-?[1-9][0-9]*\.[0-9]+)"
)
(def ^:private lex-char
@@ -86,13 +105,13 @@
(|do [[_ char] (&reader/read-regex #"^(.)")]
(return char))))
_ (&reader/read-text "\"")]
- (return (&/V &/$Meta (&/T meta (&/V "Char" token))))))
+ (return (&/V &/$Meta (&/T meta (&/V $Char token))))))
(def ^:private lex-text
(|do [[meta _] (&reader/read-text "\"")
token (lex-text-body nil)
_ (&reader/read-text "\"")]
- (return (&/V &/$Meta (&/T meta (&/V "Text" token))))))
+ (return (&/V &/$Meta (&/T meta (&/V $Text token))))))
(def ^:private lex-ident
(&/try-all% (&/|list (|do [[meta token] (&reader/read-regex +ident-re+)]
@@ -118,24 +137,24 @@
(def ^:private lex-symbol
(|do [[meta ident] lex-ident]
- (return (&/V &/$Meta (&/T meta (&/V "Symbol" ident))))))
+ (return (&/V &/$Meta (&/T meta (&/V $Symbol ident))))))
(def ^:private lex-tag
(|do [[meta _] (&reader/read-text "#")
[_ ident] lex-ident]
- (return (&/V &/$Meta (&/T meta (&/V "Tag" ident))))))
+ (return (&/V &/$Meta (&/T meta (&/V $Tag ident))))))
(do-template [<name> <text> <tag>]
(def <name>
(|do [[meta _] (&reader/read-text <text>)]
(return (&/V &/$Meta (&/T meta (&/V <tag> nil))))))
- ^:private lex-open-paren "(" "Open_Paren"
- ^:private lex-close-paren ")" "Close_Paren"
- ^:private lex-open-bracket "[" "Open_Bracket"
- ^:private lex-close-bracket "]" "Close_Bracket"
- ^:private lex-open-brace "{" "Open_Brace"
- ^:private lex-close-brace "}" "Close_Brace"
+ ^:private lex-open-paren "(" $Open_Paren
+ ^:private lex-close-paren ")" $Close_Paren
+ ^:private lex-open-bracket "[" $Open_Bracket
+ ^:private lex-close-bracket "]" $Close_Bracket
+ ^:private lex-open-brace "{" $Open_Brace
+ ^:private lex-close-brace "}" $Close_Brace
)
(def ^:private lex-delimiter
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index 762e2582f..a8b2cfc16 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -10,9 +10,28 @@
(:require [clojure.template :refer [do-template]]
clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return fail |case]]
+ (lux [base :as & :refer [deftags |do return fail |case]]
[lexer :as &lexer])))
+;; [Tags]
+(deftags ""
+ "White_Space"
+ "Comment"
+ "Bool"
+ "Int"
+ "Real"
+ "Char"
+ "Text"
+ "Symbol"
+ "Tag"
+ "Open_Paren"
+ "Close_Paren"
+ "Open_Bracket"
+ "Close_Bracket"
+ "Open_Brace"
+ "Close_Brace"
+ )
+
;; [Utils]
(do-template [<name> <close-tag> <description> <tag>]
(defn <name> [parse]
@@ -25,8 +44,8 @@
_
(fail (str "[Parser Error] Unbalanced " <description> ".")))))
- ^:private parse-form "Close_Paren" "parantheses" &/$FormS
- ^:private parse-tuple "Close_Bracket" "brackets" &/$TupleS
+ ^:private parse-form $Close_Paren "parantheses" &/$FormS
+ ^:private parse-tuple $Close_Bracket "brackets" &/$TupleS
)
(defn ^:private parse-record [parse]
@@ -34,7 +53,7 @@
token &lexer/lex
:let [elems (&/fold &/|++ (&/|list) elems*)]]
(|case token
- (&/$Meta meta ("Close_Brace" _))
+ (&/$Meta meta ($Close_Brace _))
(if (even? (&/|length elems))
(return (&/V &/$RecordS (&/|as-pairs elems)))
(fail (str "[Parser Error] Records must have an even number of elements.")))
@@ -47,42 +66,42 @@
(|do [token &lexer/lex
:let [(&/$Meta meta token*) token]]
(|case token*
- ("White_Space" _)
+ ($White_Space _)
(return (&/|list))
- ("Comment" _)
+ ($Comment _)
(return (&/|list))
- ("Bool" ?value)
+ ($Bool ?value)
(return (&/|list (&/V &/$Meta (&/T meta (&/V &/$BoolS (Boolean/parseBoolean ?value))))))
- ("Int" ?value)
+ ($Int ?value)
(return (&/|list (&/V &/$Meta (&/T meta (&/V &/$IntS (Integer/parseInt ?value))))))
- ("Real" ?value)
+ ($Real ?value)
(return (&/|list (&/V &/$Meta (&/T meta (&/V &/$RealS (Float/parseFloat ?value))))))
- ("Char" ^String ?value)
+ ($Char ^String ?value)
(return (&/|list (&/V &/$Meta (&/T meta (&/V &/$CharS (.charAt ?value 0))))))
- ("Text" ?value)
+ ($Text ?value)
(return (&/|list (&/V &/$Meta (&/T meta (&/V &/$TextS ?value)))))
- ("Symbol" ?ident)
+ ($Symbol ?ident)
(return (&/|list (&/V &/$Meta (&/T meta (&/V &/$SymbolS ?ident)))))
- ("Tag" ?ident)
+ ($Tag ?ident)
(return (&/|list (&/V &/$Meta (&/T meta (&/V &/$TagS ?ident)))))
- ("Open_Paren" _)
+ ($Open_Paren _)
(|do [syntax (parse-form parse)]
(return (&/|list (&/V &/$Meta (&/T meta syntax)))))
- ("Open_Bracket" _)
+ ($Open_Bracket _)
(|do [syntax (parse-tuple parse)]
(return (&/|list (&/V &/$Meta (&/T meta syntax)))))
- ("Open_Brace" _)
+ ($Open_Brace _)
(|do [syntax (parse-record parse)]
(return (&/|list (&/V &/$Meta (&/T meta syntax)))))
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index 7cdf9efdf..6aa8cca6d 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -10,7 +10,13 @@
(:require [clojure.string :as string]
clojure.core.match
clojure.core.match.array
- [lux.base :as & :refer [|do return* return fail fail* |let |case]]))
+ [lux.base :as & :refer [deftags |do return* return fail fail* |let |case]]))
+
+;; [Tags]
+(deftags ""
+ "No"
+ "Done"
+ "Yes")
;; [Utils]
(defn ^:private with-line [body]
@@ -22,14 +28,14 @@
(&/$Cons [[file-name line-num column-num] line]
more)
(|case (body file-name line-num column-num line)
- ("No" msg)
+ ($No msg)
(fail* msg)
- ("Done" output)
+ ($Done output)
(return* (&/set$ &/$SOURCE more state)
output)
- ("Yes" output line*)
+ ($Yes output line*)
(return* (&/set$ &/$SOURCE (&/|cons line* more) state)
output))
)))
@@ -79,10 +85,10 @@
match-length (.length match)
column-num* (+ column-num match-length)]
(if (= column-num* (.length line))
- (&/V "Done" (&/T (&/T file-name line-num column-num) match))
- (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) match)
+ (&/V $Done (&/T (&/T file-name line-num column-num) match))
+ (&/V $Yes (&/T (&/T (&/T file-name line-num column-num) match)
(&/T (&/T file-name line-num column-num*) line)))))
- (&/V "No" (str "[Reader Error] Pattern failed: " regex))))))
+ (&/V $No (str "[Reader Error] Pattern failed: " regex))))))
(defn read-regex2 [regex]
(with-line
@@ -92,10 +98,10 @@
(let [match-length (.length match)
column-num* (+ column-num match-length)]
(if (= column-num* (.length line))
- (&/V "Done" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))
- (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))
+ (&/V $Done (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))
+ (&/V $Yes (&/T (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))
(&/T (&/T file-name line-num column-num*) line)))))
- (&/V "No" (str "[Reader Error] Pattern failed: " regex))))))
+ (&/V $No (str "[Reader Error] Pattern failed: " regex))))))
(defn read-regex+ [regex]
(with-lines
@@ -127,10 +133,10 @@
(let [match-length (.length text)
column-num* (+ column-num match-length)]
(if (= column-num* (.length line))
- (&/V "Done" (&/T (&/T file-name line-num column-num) text))
- (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) text)
+ (&/V $Done (&/T (&/T file-name line-num column-num) text))
+ (&/V $Yes (&/T (&/T (&/T file-name line-num column-num) text)
(&/T (&/T file-name line-num column-num*) line)))))
- (&/V "No" (str "[Reader Error] Text failed: " text))))))
+ (&/V $No (str "[Reader Error] Text failed: " text))))))
(def ^:private ^String +source-dir+ "input/")
(defn from [^String file-name ^String file-content]
--
cgit v1.2.3