R language WIP

bin/reader.R

@@ -0,0 +1,235 @@
+delimiters <- list("(" = TRUE, ")" = TRUE, ";" = TRUE, "\r" = TRUE, "\n" = TRUE)
+whitespace <- list(" " = TRUE, "\t" = TRUE, "\r" = TRUE, "\n" = TRUE)
+stream <- function (str, more) {
+list(pos = 0, string = str, len = V_35(str), more = more)
+}
+peek_char <- function (s) {
+  V__V__id <- s
+  V__pos <- V__V__id[["pos"]]
+  V__len <- V__V__id[["len"]]
+  V__string <- V__V__id[["string"]]
+  if (V__pos < V__len) {
+    char(V__string, V__pos)
+  }
+}
+read_char <- function (s) {
+  V__c <- peek_char(s)
+  if (V__c) {
+    s[["pos"]] <<- s[["pos"]] + 1
+    V__c
+  }
+}
+skip_non_code <- function (s) {
+  while (TRUE) {
+    V__c1 <- peek_char(s)
+    if (nil63(V__c1)) {
+      break
+    } else {
+      if (whitespace[[V__c1]]) {
+        read_char(s)
+      } else {
+        if (V__c1 == ";") {
+          while (V__c1 && !( V__c1 == "\n")) {
+            V__c1 <- read_char(s)
+          }
+          skip_non_code(s)
+        } else {
+          break
+        }
+      }
+    }
+  }
+}
+read_table <- list()
+eof <- list()
+read <- function (s) {
+  skip_non_code(s)
+  V__c2 <- peek_char(s)
+  if (is63(V__c2)) {
+    (read_table[[V__c2]] || read_table[[""]])(s)
+  } else {
+    eof
+  }
+}
+read_all <- function (s) {
+  V__l <- list()
+  while (TRUE) {
+    V__form <- read(s)
+    if (V__form == eof) {
+      break
+    }
+    add(V__l, V__form)
+  }
+  V__l
+}
+read_string <- function (str, more) {
+  V__x <- read(stream(str, more))
+  if (!( V__x == eof)) {
+    V__x
+  }
+}
+key63 <- function (atom) {
+  string63(atom) && V_35(atom) > 1 && char(atom, edge(atom)) == ":"
+}
+flag63 <- function (atom) {
+  string63(atom) && V_35(atom) > 1 && char(atom, 0) == ":"
+}
+expected <- function (s, c) {
+  V__V__id1 <- s
+  V__more <- V__V__id1[["more"]]
+  V__pos1 <- V__V__id1[["pos"]]
+  V__more || error(cat("Expected ", c, " at ", V__pos1))
+}
+wrap <- function (s, x) {
+  V__y <- read(s)
+  if (V__y == s[["more"]]) {
+    V__y
+  } else {
+    list(x, V__y)
+  }
+}
+hex_prefix63 <- function (str) {
+  V__e
+  if (code(str, 0) == 45) {
+    V__e <- 1
+  } else {
+    V__e <- 0
+  }
+  V__i <- V__e
+  V__id2 <- code(str, V__i) == 48
+  V__e1
+  if (V__id2) {
+    V__i <- V__i + 1
+    V__n <- code(str, V__i)
+    V__e1 <- V__n == 120 || V__n == 88
+  } else {
+    V__e1 <- V__id2
+  }
+  V__e1
+}
+maybe_number <- function (str) {
+  if (hex_prefix63(str)) {
+    if (number_code63(code(str, edge(str)))) {
+      number(str)
+    }
+  }
+}
+real63 <- function (x) {
+  number63(x) && ! nan63(x) && ! inf63(x)
+}
+read_table[[""]] <<- function (s) {
+  V__str <- ""
+  while (TRUE) {
+    V__c3 <- peek_char(s)
+    if (V__c3 && (! whitespace[[V__c3]] && ! delimiters[[V__c3]])) {
+      V__str <- cat(V__str, read_char(s))
+    } else {
+      break
+    }
+  }
+  if (V__str == "true") {
+    TRUE
+  } else {
+    if (V__str == "false") {
+      FALSE
+    } else {
+      V__n1 <- maybe_number(V__str)
+      if (real63(V__n1)) {
+        V__n1
+      } else {
+        V__str
+      }
+    }
+  }
+}
+read_table[["("]] <<- function (s) {
+  read_char(s)
+  V__r16 <- NULL
+  V__l1 <- list()
+  while (nil63(V__r16)) {
+    skip_non_code(s)
+    V__c4 <- peek_char(s)
+    if (V__c4 == ")") {
+      read_char(s)
+      V__r16 <- V__l1
+    } else {
+      if (nil63(V__c4)) {
+        V__r16 <- expected(s, ")")
+      } else {
+        V__x1 <- read(s)
+        if (key63(V__x1)) {
+          V__k <- clip(V__x1, 0, edge(V__x1))
+          V__v <- read(s)
+          V__l1[[V__k]] <<- V__v
+        } else {
+          if (flag63(V__x1)) {
+            V__l1[[clip(V__x1, 1)]] <<- TRUE
+          } else {
+            add(V__l1, V__x1)
+          }
+        }
+      }
+    }
+  }
+  V__r16
+}
+read_table[[")"]] <<- function (s) {
+  error(cat("Unexpected ) at ", s[["pos"]]))
+}
+read_table[["\""]] <<- function (s) {
+  read_char(s)
+  V__r19 <- NULL
+  V__str1 <- "\""
+  while (nil63(V__r19)) {
+    V__c5 <- peek_char(s)
+    if (V__c5 == "\"") {
+      V__r19 <- cat(V__str1, read_char(s))
+    } else {
+      if (nil63(V__c5)) {
+        V__r19 <- expected(s, "\"")
+      } else {
+        if (V__c5 == "\\") {
+          V__str1 <- cat(V__str1, read_char(s))
+        }
+        V__str1 <- cat(V__str1, read_char(s))
+      }
+    }
+  }
+  V__r19
+}
+read_table[["|"]] <<- function (s) {
+  read_char(s)
+  V__r21 <- NULL
+  V__str2 <- "|"
+  while (nil63(V__r21)) {
+    V__c6 <- peek_char(s)
+    if (V__c6 == "|") {
+      V__r21 <- cat(V__str2, read_char(s))
+    } else {
+      if (nil63(V__c6)) {
+        V__r21 <- expected(s, "|")
+      } else {
+        V__str2 <- cat(V__str2, read_char(s))
+      }
+    }
+  }
+  V__r21
+}
+read_table[["'"]] <<- function (s) {
+  read_char(s)
+  wrap(s, "quote")
+}
+read_table[["`"]] <<- function (s) {
+  read_char(s)
+  wrap(s, "quasiquote")
+}
+read_table[[","]] <<- function (s) {
+  read_char(s)
+  if (peek_char(s) == "@") {
+    read_char(s)
+    wrap(s, "unquote-splicing")
+  } else {
+    wrap(s, "unquote")
+  }
+}
+return list(stream = stream, read = read, "read-all" = read_all, "read-string" = read_string, "read-table" = read_table)

bin/reader.js

@@ -5,17 +5,17 @@ var stream = function (str, more) {
 };
 var peek_char = function (s) {
   var ____id = s;
-  var __pos = ____id.pos;
-  var __len = ____id.len;
-  var __string = ____id.string;
+  var __pos = ____id["pos"];
+  var __len = ____id["len"];
+  var __string = ____id["string"];
   if (__pos < __len) {
     return char(__string, __pos);
   }
 };
 var read_char = function (s) {
   var __c = peek_char(s);
   if (__c) {
-    s.pos = s.pos + 1;
+    s["pos"] = s["pos"] + 1;
     return __c;
   }
 };
@@ -76,13 +76,13 @@ var flag63 = function (atom) {
 };
 var expected = function (s, c) {
   var ____id1 = s;
-  var __more = ____id1.more;
-  var __pos1 = ____id1.pos;
+  var __more = ____id1["more"];
+  var __pos1 = ____id1["pos"];
   return __more || error("Expected " + c + " at " + __pos1);
 };
 var wrap = function (s, x) {
   var __y = read(s);
-  if (__y === s.more) {
+  if (__y === s["more"]) {
     return __y;
   } else {
     return [x, __y];
@@ -176,7 +176,7 @@ read_table["("] = function (s) {
   return __r16;
 };
 read_table[")"] = function (s) {
-  return error("Unexpected ) at " + s.pos);
+  return error("Unexpected ) at " + s["pos"]);
 };
 read_table["\""] = function (s) {
   read_char(s);
@@ -234,8 +234,8 @@ read_table[","] = function (s) {
     return wrap(s, "unquote");
   }
 };
-exports.stream = stream;
-exports.read = read;
+exports["stream"] = stream;
+exports["read"] = read;
 exports["read-all"] = read_all;
 exports["read-string"] = read_string;
 exports["read-table"] = read_table;

bin/reader.lua

@@ -5,17 +5,17 @@ local function stream(str, more)
 end
 local function peek_char(s)
   local ____id = s
-  local __pos = ____id.pos
-  local __len = ____id.len
-  local __string = ____id.string
+  local __pos = ____id["pos"]
+  local __len = ____id["len"]
+  local __string = ____id["string"]
   if __pos < __len then
     return char(__string, __pos)
   end
 end
 local function read_char(s)
   local __c = peek_char(s)
   if __c then
-    s.pos = s.pos + 1
+    s["pos"] = s["pos"] + 1
     return __c
   end
 end
@@ -76,13 +76,13 @@ local function flag63(atom)
 end
 local function expected(s, c)
   local ____id1 = s
-  local __more = ____id1.more
-  local __pos1 = ____id1.pos
+  local __more = ____id1["more"]
+  local __pos1 = ____id1["pos"]
   return __more or error("Expected " .. c .. " at " .. __pos1)
 end
 local function wrap(s, x)
   local __y = read(s)
-  if __y == s.more then
+  if __y == s["more"] then
     return __y
   else
     return {x, __y}
@@ -176,7 +176,7 @@ read_table["("] = function (s)
   return __r16
 end
 read_table[")"] = function (s)
-  return error("Unexpected ) at " .. s.pos)
+  return error("Unexpected ) at " .. s["pos"])
 end
 read_table["\""] = function (s)
   read_char(s)

bin/system.R

@@ -0,0 +1,29 @@
+read_file <- function (path) {
+}
+write_file <- function (path, data) {
+}
+file_exists63 <- function (path) {
+}
+directory_exists63 <- function (path) {
+}
+path_separator
+path_join <- function (...) {
+  V__parts <- list(...)
+  reduce(function (x, y) {
+    cat(x, path_separator, y)
+  }, V__parts) || ""
+}
+get_environment_variable <- function (name) {
+}
+write <- function (x) {
+}
+exit <- function (code) {
+}
+argv
+reload <- function (module) {
+  NULL <- NULL
+  require(module)
+}
+run <- function (command) {
+}
+return list("read-file" = read_file, "write-file" = write_file, "file-exists?" = file_exists63, "directory-exists?" = directory_exists63, "path-separator" = path_separator, "path-join" = path_join, "get-environment-variable" = get_environment_variable, write = write, exit = exit, argv = argv, reload = reload, run = run)