diff options
Diffstat (limited to '')
| -rw-r--r-- | source/luxc/lexer.lux | 119 | ||||
| -rw-r--r-- | source/luxc/parser.lux | 72 | ||||
| -rw-r--r-- | source/luxc/util.lux | 169 | ||||
| -rw-r--r-- | source/test2.lux | 25 |
4 files changed, 0 insertions, 385 deletions
diff --git a/source/luxc/lexer.lux b/source/luxc/lexer.lux deleted file mode 100644 index ed86be68f..000000000 --- a/source/luxc/lexer.lux +++ /dev/null @@ -1,119 +0,0 @@ -(use ./util #as &util #refer [do return fail try-all]) - -## [Utils] -(def (lex-regex regex) - ...) - -(def (lex-regex2 regex) - ...) - -(def (lex-prefix prefix) - ...) - -(def (escape-char escaped) - (case escaped - "\\t" (return "\t") - "\\b" (return "\b") - "\\n" (return "\n") - "\\r" (return "\r") - "\\f" (return "\f") - "\\\"" (return "\"") - "\\\\" (return "\\") - _ (fail (fold concat "" (list "[Lexer Error] Unknown escape character: " escaped))))) - -(defrec lex-text-body - (try-all (list (do [[prefix escaped] (lex-regex2 "(?s)^([^\\\"\\\\]*)(\\\\.)") - unescaped (escape-char escaped) - postfix lex-text-body] - (return (str prefix unescaped postfix))) - (lex-regex "(?s)^([^\\\"\\\\]*)^")))) - -(def +ident-re+ ...) - -## [Lexers] -(def lex-white-space - (do [white-space (lex-regex #"^(\s+)")] - (return (#White-Space white-space)))) - -(def lex-single-line-comment - (do [_ (lex-prefix "##") - comment (lex-regex #"^([^\n]*)") - _ (lex-regex #"^(\n?)")] - (return (#Comment comment)))) - -(def lex-multi-line-comment - (do [_ (lex-prefix "#(") - comment (try-all (list (lex-regex #"(?is)^((?!#\().)*?(?=\)#)") - (do [pre (lex-regex #"(?is)^(.+?(?=#\())") - [_ inner] lex-multi-line-comment - post (lex-regex #"(?is)^(.+?(?=\)#))")] - (return (fold concat "" (list pre "#(" inner ")#" post)))))) - _ (lex-prefix ")#")] - (return (#Comment comment)))) - -(def lex-comment - (try-all (list lex-single-line-comment - lex-multi-line-comment))) - -(do-template [<name> <tag> <regex>] - (def <name> - (do [token (lex-regex <regex>)] - (return (<tag> token)))) - - lex-bool #Bool #"^(true|false)" - lex-real #Real #"^(0|[1-9][0-9]*)\.[0-9]+" - lex-int #Int #"^(0|[1-9][0-9]*)" - lex-ident #Ident +ident-re+) - -(def lex-char - (do [_ (lex-prefix "#\"") - token (try-all (list (do [escaped (lex-regex #"^(\\.)")] - (escape-char escaped)) - (lex-regex #"^(.)"))) - _ (lex-prefix "\"")] - (return (#Char token)))) - -(def lex-text - (do [_ (lex-prefix "\"") - token lex-text-body - _ (lex-prefix "\"")] - (return (#Text token)))) - -(def lex-tag - (do [_ (lex-prefix "#") - token (lex-regex +ident-re+)] - (return (#Tag token)))) - -(do-template [<name> <delim> <tag>] - (def <name> - (do [_ (lex-prefix <delim>)] - (return <tag>))) - - lex-open-paren "(" #Open-Paren - lex-close-paren ")" #Close-Paren - lex-open-bracket "[" #Open-Bracket - lex-close-bracket "]" #Close-Bracket - lex-open-brace "{" #Open-Brace - lex-close-brace "}" #Close-Brace - ) - -(def lex-delimiter - (try-all (list lex-open-paren - lex-close-paren - lex-open-bracket - lex-close-bracket - lex-open-brace - lex-close-brace))) - -;; [Interface] -(def #export lex - (try-all (list lex-white-space - lex-comment - lex-bool - lex-real - lex-int - lex-char - lex-text - lex-ident - lex-tag - lex-delimiter))) diff --git a/source/luxc/parser.lux b/source/luxc/parser.lux deleted file mode 100644 index 35ec12b17..000000000 --- a/source/luxc/parser.lux +++ /dev/null @@ -1,72 +0,0 @@ -(use ./util #as &util #refer [do return fail try-all repeat]) -(use ./lexer #as &lexer) - -;; [Utils] -(do-template [<name> <close-token> <description> <tag>] - (def (<name> parse) - (do [elems (repeat parse) - token &lexer:lex] - (case token - <close-token> - (return (list (<tag> (fold ++ (list) elems)))) - - _ - (fail (concat (list "[Parser Error] Unbalanced " <description> ".")))))) - - parse-form #&lexer:Close-Paren "parantheses" #Form - parse-tuple #&lexer:Close-Bracket "brackets" #Tuple - ) - -(def (parse-record parse) - (do [elems* (repeat parse) - token &lexer:lex - #let [elems (fold ++ (list) elems*)]] - (case token - #&lexer:Close-Bracket - (if (odd? (size elems)) - (fail "[Parser Error] Records must have an even number of elements.") - (return (list (#Record elems)))) - - _ - (fail "[Parser Error] Unbalanced braces.")))) - -;; [Interface] -(def parse - (do [token &lexer/lex] - (match token - (#&lexer:White-Space _) - (return (list)) - - (#&lexer:Comment _) - (return (list)) - - (#&lexer:Bool ?value) - (return (list [#Bool (jvm:invokestatic Boolean "parseBoolean" [String] [?value])])) - - (#&lexer:Int ?value) - (return (list [#Int (jvm:invokestatic Integer "parseInt" [String] [?value])])) - - (#&lexer:Real ?value) - (return (list [#Real (jvm:invokestatic Float "parseFloat" [String] [?value])])) - - (#&lexer:Char ?value) - (return (list [#Char (jvm:invokevirtual String "charAt" [int] ?value [0])])) - - (#&lexer:Text ?value) - (return (list [#Text ?value])) - - (#&lexer:Ident ?value) - (return (list [#Ident ?value])) - - (#&lexer:Tag ?value) - (return (list [#Tag ?value])) - - #&lexer:Open-Paren - (parse-form parse) - - #&lexer:Open-Bracket - (parse-tuple parse) - - #&lexer:Open-Brace - (parse-record parse) - ))) diff --git a/source/luxc/util.lux b/source/luxc/util.lux deleted file mode 100644 index 88b035571..000000000 --- a/source/luxc/util.lux +++ /dev/null @@ -1,169 +0,0 @@ -(def (fail* message) - (#Failure message)) - -(def (return* state value) - (#Ok [state value])) - -(def (fail message) - (lambda [state] - (#Failure message))) - -(def (return value) - (lambda [state] - (#Ok [state value]))) - -(def (bind m-value step) - (lambda [state] - (let inputs (m-value state) - (case inputs - (#Ok [?state ?datum]) - (step ?datum ?state) - - _ - inputs)))) - -## Ideally, this is what I want... -## (exec [yolo lol -## #let [foo (bar 1 2 3)]] -## (meme yolo foo)) - -(defmacro (exec tokens) - (case tokens - (#Cons (#Tuple steps) (#Cons value #Nil)) - (fold (lambda [inner pair] - (case pair - [label computation] - (' (bind (~ computation) (lambda [(~ label)] (~ inner)))))) - value - (pairs steps)))) - -(def (try-m monad) - (lambda [state] - (case (monad state) - (#Ok [?state ?datum]) - (return* ?state (#Just ?datum)) - - (#Failure _) - (return* state #Nothing)))) - -(def (repeat-m monad) - (lambda [state] - (case (monad state) - (#Ok [?state ?head]) - (case ((repeat-m monad) ?state) - (#Ok [?state* ?tail]) - (return* ?state* (#Cons ?head ?tail))) - - (#Failure ?message) - (return* state #Nil)))) - -(def (try-all-m monads) - (lambda [state] - (case monads - #Nil - (fail* "No alternative worked!") - (#Cons monad monads') - (let output (monad state) - (case output - (#Ok _) - output - - (#Failure _) - (case monads' - #Nil - output - (#Cons _ _) - ((try-all-m monads') state)) - )) - ))) - -(def (map-m f inputs) - (case inputs - #Nil - (return #Nil) - (#Cons input inputs') - (exec [output (f input) - outputs (map-m f inputs')] - (return (#Cons output outputs))))) - -(def (fold-m f init inputs) - (case inputs - #Nil (return init) - (#Cons x inputs') (exec [init* (f init x)] - (fold-m f init* inputs')))) - -(def (apply-m monad call-state) - (lambda [state] - (let output (monad call-state) - (case output - (#Ok [?state ?datum]) - (#Ok [state ?datum]) - - _ - output)))) - -(def (assert test message) - (if test - (return []) - (fail message))) - -(def (pass %value) - (lambda [state] - %value)) - -(def get-state - (lambda [state] - (return* state state))) - -(def (normalize-char char) - (case char - #"*" "_ASTER_" - #"+" "_PLUS_" - #"-" "_DASH_" - #"/" "_SLASH_" - #"_" "_UNDERS_" - #"%" "_PERCENT_" - #"$" "_DOLLAR_" - #"'" "_QUOTE_" - #"`" "_BQUOTE_" - #"@" "_AT_" - #"^" "_CARET_" - #"&" "_AMPERS_" - #"=" "_EQ_" - #"!" "_BANG_" - #"?" "_QM_" - #":" "_COLON_" - #";" "_SCOLON_" - #"." "_PERIOD_" - #"," "_COMMA_" - #"<" "_LT_" - #">" "_GT_" - #"~" "_TILDE_" - ##;;#"\" "_BSLASH_" - _ (show char) - )) - -(def (normalize-ident ident) - (fold concat "" (map normalize-char (text->list ident)))) - -(def (within slot monad) - (lambda [state] - (let =return (monad (get slot state)) - (case =return - (#Ok ?state ?value) - (#Ok (put slot ?state state) ?value) - - _ - =return)))) - -(def (run-state monad state) - (monad state)) - -(def (fresh-class-loader path) - (let file (jvm/new java.io.File [String] [path]) - (let url (jvm/invokevirtual java.io.File "toURL" [] - file []) - (let urls (jvm/new-array java.net.URL 1) - (do (jvm/aastore urls 0 url) - (jvm/new java.net.URLClassLoader [(Array java.net.URL)] [urls])))) - )) diff --git a/source/test2.lux b/source/test2.lux deleted file mode 100644 index f2fe02bb8..000000000 --- a/source/test2.lux +++ /dev/null @@ -1,25 +0,0 @@ -(require "./util") - -(def (print-enum enum) - (case enum - #Nil - (println "") - - (#Cons [idx x] enum') - (do (print "[") (print idx) (print ":") (print x) (print "]") (print " ") - (print-enum enum')))) - -#((def monadic-dup - (util:exec [foo get-state - bar get-state - baz (util:return 1000)] - (util:return (+ (+ foo bar) baz)))))# - -(def (print-map list-map) - (do (print "{") - (print (fold concat "" (interpose " " (map show-kv list-map)))) - (println "}"))) - -## Program -(def (main args) - (println "Hello, world!")) |