sibilant 0.0.1 → 0.0.2

data/js/sibilant/src/core.sibilant

@@ -0,0 +1,338 @@
+(set sibilant 'tokens {})
+
+(set sibilant.tokens
+     'regex              "(\\/(\\\\\\\/|[^\\/\\n])+\\/[glim]*)"
+     'comment            "(;.*)"
+     'string             "(\"(([^\"]|(\\\\\"))*[^\\\\])?\")"
+     'number             "(-?[0-9][0-9.,]*)"
+     'literal            "(-?[*.$a-zA-Z][*.a-zA-Z0-9-]*(\\?|!)?)"
+     'special            "([&']?)"
+     'other-char         "([><=!\\+\\/\\*-]+)"
+     'open-paren         "(\\()"
+     'special-open-paren "('?\\()"
+     'close-paren        "(\\))"
+     'alternative-parens "\\{|\\[|\\}|\\]"
+     'special-literal    (concat sibilant.tokens.special
+                                 sibilant.tokens.literal))
+
+(set sibilant 'token-precedence
+     '( regex comment string number special-literal other-char
+              special-open-paren close-paren alternative-parens))
+
+(defvar tokenize
+        (setf sibilant.tokenize
+              (lambda (string)
+                (defvar tokens []
+                        parse-stack [tokens]
+                        specials [])
+
+                (defun accept-token (token)
+                  (send (get parse-stack 0) push token))
+
+                (defun increase-nesting ()
+                  (defvar new-arr [])
+                  (accept-token new-arr)
+                  (parse-stack.unshift new-arr))
+
+                (defun decrease-nesting ()
+                  (specials.shift)
+                  (parse-stack.shift)
+                  (when (zero? parse-stack.length)
+                    (throw (concat "unbalanced parens:\n"
+                                   (call inspect parse-stack)))))
+
+                (defun handle-token (token)
+                  (defvar special (first token)
+                          token token)
+
+                  (if (= special "'")
+                    (progn
+                      (setf token (token.slice 1))
+                      (increase-nesting)
+                      (accept-token 'quote))
+                    (setf special false))
+
+                  (specials.unshift (as-boolean special))
+
+                  (switch token
+                    ("(" (increase-nesting))
+                    (("]" "}" ")") (decrease-nesting))
+
+                    ("{" (increase-nesting) (accept-token 'hash))
+                    ("[" (increase-nesting) (accept-token 'list))
+
+                    (default
+                     (if (token.match (regex (concat "^" sibilant.tokens.number "$")))
+                       (accept-token (parse-float (token.replace (regex "," 'g) "")))
+                       (accept-token token))))
+
+                  (when (and (!= token "(")
+                             (specials.shift))
+                    (decrease-nesting)))
+
+
+
+                (defvar ordered-regexen (map sibilant.token-precedence
+                                             (lambda (x) (get sibilant.tokens x)))
+                        master-regex (regex (join "|" ordered-regexen) 'g))
+
+                (chain string
+                  (match master-regex)
+                  (for-each handle-token))
+
+                (when (> parse-stack.length 1)
+                  (error "unexpected EOF, probably missing a )\n"
+                         (call inspect (first parse-stack))))
+                tokens)))
+
+(defun indent (&rest args)
+  (concat
+   (chain (compact args)
+     (join "\n")
+     (replace /^/ "\n")
+     (replace /\n/g "\n  "))
+   "\n"))
+
+(defun construct-hash (array-of-arrays)
+  (inject {} array-of-arrays
+          (lambda (object item)
+            (set object (first item) (get object (second item)))
+            object)))
+
+(defvar macros (hash))
+(set sibilant 'macros macros)
+
+(set macros 'return
+     (lambda (token)
+       (defvar default-return (concat "return " (translate token)))
+
+       (if (list? token)
+         (switch (first token)
+           ('(return throw progn) (translate token))
+           ('delete
+            (defvar delete-macro (get macros 'delete))
+            (if (< token.length 3) default-return
+                (concat (apply delete-macro (token.slice 1 -1))
+                        "\nreturn "
+                        (delete-macro (last token)))))
+           ('setf
+            (if (< token.length 4) default-return
+                (concat (apply macros.setf
+                               (token.slice 1 (- token.length 2)))
+                        "\nreturn "
+                        (apply macros.setf (token.slice -2)))))
+           ('set
+            (if (< token.length 5) default-return
+                (progn
+                  (defvar obj (second token)
+                          non-return-part (token.slice 2 (- token.length 2))
+                          return-part (token.slice -2))
+                  (non-return-part.unshift obj)
+                  (return-part.unshift obj)
+                  (concat (apply macros.set non-return-part)
+                          "\nreturn "
+                          (apply macros.set return-part)))))
+           (default default-return))
+         default-return)))
+
+(defun as-statement (string)
+  (chain string (to-string) (replace /;*\s*$/ ";")))
+
+(defun macros.statement (&rest args)
+  (concat (apply macros.call args) ";\n"))
+
+(defun macros.progn (&rest body)
+  (defvar last-index (-math.max 0 (- body.length 1)))
+
+  (set body last-index ['return (get body last-index)])
+
+  (join "\n"
+        (map body (lambda (arg)
+                    (concat (as-statement (translate arg)))))))
+
+(defun macros.call (fn-name &rest args)
+  (concat (translate fn-name)
+          "(" (join ", " (map args translate)) ")"))
+
+(defun macros.defun (fn-name &rest args-and-body)
+  (defvar fn-name-tr (translate fn-name)
+          start (if (match? /\./ fn-name-tr) "" "var "))
+  (concat start fn-name-tr " = "
+          (apply macros.lambda args-and-body)
+          ";\n"))
+
+(defun macros.defmacro (name &rest args-and-body)
+  (defvar js (apply macros.lambda args-and-body)
+          name (translate name))
+  (try (set macros name (eval js))
+       (error (concat "error in parsing macro "
+                      name ":\n" (indent js))))
+  undefined)
+
+(defun macros.concat (&rest args)
+  (concat "(" (join " + " (map args translate)) ")"))
+
+(defun transform-args (arglist)
+  (defvar last undefined
+          args [])
+  (each (arg) arglist
+    (if (= (first arg) "&") (setf last (arg.slice 1))
+        (progn
+          (args.push [ (or last 'required) arg ])
+          (setf last null))))
+
+  (when last
+    (error (concat "unexpected argument modifier: " last)))
+
+  args)
+
+
+(defun macros.reverse (arr)
+  (defvar reversed [])
+  (each (item) arr (reversed.unshift item))
+  reversed)
+
+(defvar reverse macros.reverse)
+
+(defun build-args-string (args rest)
+  (defvar args-string ""
+          optional-count 0)
+
+  (each (arg option-index) args
+    (when (= (first arg) 'optional)
+      (setf
+       args-string
+       (concat
+        args-string
+        "if (arguments.length < "
+        (- args.length optional-count) ")"
+        " // if " (translate (second arg)) " is missing"
+        (indent
+         (concat "var "
+                 (chain
+                     (map (args.slice (+ option-index 1))
+                          (lambda (arg arg-index)
+                            (concat (translate (second arg)) " = "
+                                    (translate (second (get args
+                                                            (+ option-index
+                                                               arg-index)))))))
+                   (reverse)
+                   (concat (concat (translate (second arg)) " = undefined"))
+                   (join ", "))
+                 ";"))))
+      (incr optional-count)))
+
+  (if (defined? rest)
+    (concat args-string
+            "var " (translate (second rest))
+            " = Array.prototype.slice.call(arguments, "
+            args.length ");\n")
+    args-string))
+
+(defun build-comment-string (args)
+  (if (empty? args) ""
+      (concat "// "
+              (join " "
+                    (map args
+                         (lambda (arg)
+                           (concat (translate (second arg)) ":" (first arg))))))))
+
+;; brain 'splode
+(defun macros.lambda (arglist &rest body)
+  (defvar args (transform-args arglist)
+          rest (first (select args
+                              (lambda (arg)
+                                (= 'rest (first arg)))))
+          doc-string undefined)
+
+  (set body (- body.length 1)
+       [ 'return (get body (- body.length 1)) ])
+
+  (when (and (= (typeof (first body)) 'string)
+             (send (first body) match /^".*"$/))
+    (setf doc-string
+          (concat "/* " (eval (body.shift)) " */\n")))
+
+  (defvar no-rest-args (if rest (args.slice 0 -1) args)
+          args-string (build-args-string no-rest-args rest)
+          comment-string (build-comment-string args))
+
+  (concat "(function("
+          (join ", " (map args (lambda (arg) (translate (second arg)))))
+          ") {"
+          (indent comment-string doc-string args-string
+                  (join "\n"
+                        (map body
+                             (lambda (stmt)
+                               (defvar tstmt (translate stmt))
+                               (concat tstmt
+                                 (if (= (last tstmt) ";") "" ";"))))))
+          "})"))
+
+
+(defun macros.quote (item)
+  (if (= "Array" item.constructor.name)
+    (concat "[ " (join ", " (map item macros.quote)) " ]")
+    (if (= 'number (typeof item)) item
+        (concat "\"" (literal item) "\""))))
+
+(defun macros.hash (&rest pairs)
+  (when (odd? pairs.length)
+    (error (concat
+            "odd number of key-value pairs in hash: "
+            (call inspect pairs))))
+  (defvar pair-strings
+          (bulk-map pairs (lambda (key value)
+                            (concat (translate key) ": "
+                                    (translate value)))))
+  (if (>= 1 pair-strings.length)
+    (concat "{ " (join ", " pair-strings) " }")
+    (concat "{" (indent (join ",\n" pair-strings)) "}")))
+
+
+(defun literal (string)
+  (inject (chain string
+            (replace /\*/g "_")
+            (replace /\?$/ "__QUERY")
+            (replace /!$/  "__BANG"))
+          (string.match /-(.)/g)
+          (lambda (return-string match)
+            (return-string.replace match
+                                   (send (second match) to-upper-case)))))
+
+
+(defun translate (token hint)
+  (defvar hint hint)
+  (when (and hint (undefined? (get macros hint)))
+    (setf hint undefined))
+
+  (when (defined? token)
+    (when (string? token) (setf token (token.trim)))
+    (try
+      (if (list? token)
+        (if (defined? (get macros (translate (first token))))
+          (apply (get macros (translate (first token))) (token.slice 1))
+          (apply (get macros (or hint 'call)) token))
+        (if (and (string? token)
+                 (token.match (regex (concat "^" sibilant.tokens.literal "$"))))
+          (literal token)
+          (if (and (string? token) (token.match (regex "^;")))
+            (token.replace (regex "^;+") "//")
+            (if (and (string? token) (= "\"" (first token) (last token)))
+              (chain token (split "\n") (join "\\n\" +\n\""))
+              token))))
+      (error (concat e.stack "\n"
+                     "Encountered when attempting to process:\n"
+                     (indent (call inspect token)))))))
+
+
+(set sibilant 'translate translate)
+
+(defun translate-all (contents)
+  (defvar buffer "")
+  (each (token) (tokenize contents)
+    (defvar line (translate token 'statement))
+    (when line (setf buffer (concat buffer line "\n"))))
+  buffer)
+
+(set sibilant 'translate-all translate-all)

data/js/sibilant/src/options.sibilant

@@ -0,0 +1,65 @@
+(include "../include/functional")
+
+(defun extract-options (config &optional args)
+  (defvar args (or args (process.argv.slice 2))
+          default-label 'unlabeled
+          current-label default-label
+          after-break false
+          config (or config {})
+          unlabeled [])
+
+  (defun label? (item) (and (string? item) (send /^-/ test item)))
+
+  (defun synonym-lookup (item)
+    (defvar config-entry (get config item))
+    (if (string? config-entry)
+      (synonym-lookup config-entry)
+      item))
+
+  (defun takes-args? (item)
+    (!= false (get config (label-for item))))
+
+  (setf default-label (synonym-lookup default-label)
+        current-label default-label)
+
+  (defun label-for (item)
+    (synonym-lookup (item.replace /^-+/ "")))
+
+  (defun add-value (hash key value)
+    (defvar current-value (get hash key))
+    (when (undefined? current-value)
+      (setf current-value [])
+      (set hash key current-value))
+    (when (!= true value)
+      (current-value.push value)))
+
+  (defun reset-label ()
+    (setf current-label default-label))
+
+  (inject {} args
+          (lambda (return-hash item index)
+            (if (= "--" item) (setf after-break true)
+                (if after-break
+                  (add-value return-hash 'after-break item)
+                  (if (label? item)
+                    (progn
+                      (setf current-label (label-for item))
+                      (add-value return-hash current-label true)
+                      (when (not (takes-args? item)) (reset-label)))
+                    (progn
+                      (add-value return-hash current-label item)
+                      (reset-label)))))
+            return-hash)))
+
+(defun process-options (&optional config)
+  (defvar options (extract-options config))
+  (when config
+    (defun handle-pair (key value)
+      (defvar handle (get config key))
+      (when (string? handle) (handle-pair handle value))
+      (when (function? handle) (handle value options)))
+    (each (key) (keys options) (handle-pair key (get options key))))
+
+  options)
+
+(set module 'exports process-options)

data/js/sibilant/src/repl.sibilant

@@ -0,0 +1,59 @@
+(defvar input      (process.open-stdin)
+        output     process.stdout
+        vm         (require 'vm)
+        readline   (send (require 'readline) create-interface input output)
+        sibilant   (require "./sibilant")
+        context    undefined
+        cmd-buffer ""
+        util       (require 'util))
+
+(defun create-context ()
+  (defvar context (vm.create-context))
+  (set module 'filename (concat (process.cwd) "/exec"))
+  (set context
+       'module  module
+       'require require)
+  (each-key key global (set context key (get global key)))
+  context)
+
+(setf context (create-context))
+
+(defun display-prompt ()
+  (readline.set-prompt
+   (concat (if (> cmd-buffer.length 10)
+             (concat "..." (cmd-buffer.slice -10))
+             (if (> cmd-buffer.length 0) cmd-buffer "sibilant"))
+           "> "))
+  (readline.prompt))
+
+(readline.on 'line
+             (lambda (cmd)
+               (defvar js-line "")
+
+               (try
+                 (progn
+                   (setf cmd-buffer (concat cmd-buffer cmd))
+                   (each (stmt) (sibilant.tokenize cmd-buffer)
+                     (setf js-line (concat js-line
+                                           (sibilant.translate stmt 'statement))))
+                   (defvar result (vm.run-in-context js-line context "sibilant-repl"))
+                   (set readline.history 0 cmd-buffer)
+                   (when (defined? result)
+                     (output.write (concat "result: "
+                                           (util.inspect result) "\n")))
+                   (set context "_" result)
+                   (setf cmd-buffer ""))
+                 (progn
+                   (if (e.message.match /unexpected EOF/)
+                     (progn
+                       (setf cmd-buffer (concat cmd-buffer " "))
+                       (readline.history.shift))
+                     (progn
+                       (set readline.history 0 cmd-buffer)
+                       (output.write (concat e.stack "\n"))
+                       (setf  cmd-buffer "")))))
+               (display-prompt)))
+
+(readline.on 'close input.destroy)
+
+(display-prompt)

data/js/sibilant/src/sibilant.sibilant

@@ -0,0 +1,78 @@
+(defvar sibilant exports
+        util     (require 'util)
+        path     (require 'path)
+        fs       (require 'fs)
+        error    (lambda (str) (throw str))
+        inspect  util.inspect)
+
+(include "../include/functional")
+
+(defun sibilant.package-info ()
+  (defvar fs (require 'fs))
+  (JSON.parse (fs.read-file-sync
+               (concat **dirname "/../package.json"))))
+
+(defun sibilant.version-string ()
+  (defvar package (sibilant.package-info)
+    path (require 'path))
+  (concat package.name " version " package.version
+                       "\n(at " (path.join **dirname "..") ")"))
+
+(defun sibilant.strip-shebang (data)
+  (data.replace /^#!.*\n/ ""))
+
+(set sibilant
+     'file 'eval.sibilant
+     'dir  (process.cwd))
+
+(defun with-dir-and-file (dir file fn)
+  (defvar before { dir sibilant.dir
+                   file sibilant.file })
+  (set sibilant
+       'dir  dir
+       'file file)
+
+  (defvar retval (fn))
+
+  (set sibilant
+       'dir  before.dir
+       'file before.file)
+
+  retval)
+
+
+(defun sibilant.translate-file (file-name)
+  (with-dir-and-file (path.dirname file-name)
+                     file-name
+                     (thunk
+                       (sibilant.translate-all
+                        (sibilant.strip-shebang
+                         (fs.read-file-sync file-name "utf8"))))))
+
+
+(defun sibilant.version ()
+  (get (sibilant.package-info) 'version))
+
+(set require.extensions ".sibilant"
+     (lambda (module filename)
+       (defvar content (sibilant.translate-file filename))
+       (module.*compile content filename)))
+
+(defun sibilant.include (file)
+  (when (not (file.match (regex ".sibilant$")))
+    (setf file (concat file ".sibilant")))
+
+  (when (file.match (regex "^\.\.?/"))
+    (setf file (concat sibilant.dir "/" file)))
+
+  (defvar resolved (require.resolve file))
+
+  (sibilant.translate-file resolved))
+
+
+(include "../src/core")
+
+(defun macros.include (file)
+  (sibilant.include (eval (translate file))))
+
+(sibilant.include (path.normalize (concat **dirname "/../include/macros")))

data/js/sibilant/test/defvar.sibilant

@@ -0,0 +1,5 @@
+(defun alert-hello (planet-name)
+  (defvar message (concat "hello " planet-name))
+    message)
+
+(defvar foo (concat "hi " "there"))

data/js/sibilant/test/includeFile1.sibilant

@@ -0,0 +1 @@
+1

data/js/sibilant/test/includeFile2.sibilant

@@ -0,0 +1 @@
+2

data/js/sibilant/test/node.sibilant

@@ -0,0 +1,10 @@
+#!/usr/bin/env sibilant -x
+(include "./testHelper.sibilant")
+
+(sibilant.include "sibilant/include/node")
+
+(assert-translation "(on thing event (arg1 arg2) (concat arg1 arg2))"
+                    "thing.on(\"event\", (function(arg1, arg2) {
+  // arg1:required arg2:required
+  return (arg1 + arg2);
+}))")

data/js/sibilant/test/slice.sibilant

@@ -0,0 +1,3 @@
+(defvar sliced (slice '(1 2 3 4)))
+
+(defvar other (slice '(1 2 3 4) 0 2))