├── .Rbuildignore ├── .gitignore ├── .travis.yml ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── R ├── evaluator.R ├── parser.R └── repl.R ├── README.Rmd ├── README.md ├── codecov.yml ├── man ├── evaluate.Rd ├── parse.Rd ├── repl.Rd └── translate.Rd └── tests ├── testthat.R └── testthat ├── test-evaluator.R ├── test-parser.R └── test-repl.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^LICENSE\.md$ 2 | ^\.travis\.yml$ 3 | ^codecov\.yml$ 4 | ^README\.Rmd$ 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # Example code in package build process 9 | *-Ex.R 10 | 11 | # Output files from R CMD build 12 | /*.tar.gz 13 | 14 | # Output files from R CMD check 15 | /*.Rcheck/ 16 | 17 | # RStudio files 18 | .Rproj.user/ 19 | 20 | # produced vignettes 21 | vignettes/*.html 22 | vignettes/*.pdf 23 | 24 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 25 | .httr-oauth 26 | 27 | # knitr and R markdown default cache directories 28 | /*_cache/ 29 | /cache/ 30 | 31 | # Temporary files created by R markdown 32 | *.utf8.md 33 | *.knit.md 34 | 35 | README.html 36 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | cache: packages 5 | after_success: 6 | - Rscript -e 'covr::codecov()' 7 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: lisprr 2 | Version: 0.0.0.9000 3 | Title: What the Package Does (One Line, Title Case) 4 | Description: What the package does (one paragraph). 5 | Authors@R: person("First", "Last", , "first.last@example.com", c("aut", "cre")) 6 | License: MIT + file LICENSE 7 | Encoding: UTF-8 8 | LazyData: true 9 | ByteCompile: true 10 | Suggests: 11 | testthat, 12 | covr 13 | RoxygenNote: 6.0.1 14 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2018 2 | COPYRIGHT HOLDER: igjit 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2018 igjit 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(evaluate) 4 | export(repl) 5 | export(translate) 6 | -------------------------------------------------------------------------------- /R/evaluator.R: -------------------------------------------------------------------------------- 1 | #' Evaluate s-expression 2 | #' 3 | #' @param s s-expression 4 | #' @param ... additional arguments 5 | #' @export 6 | evaluate <- function(s, ...) { 7 | base::eval(translate(s), ...) 8 | } 9 | 10 | #' Translate s-expression to R 11 | #' 12 | #' @param s s-expression 13 | #' @export 14 | translate <- function(s) { 15 | compile(parse(s)) 16 | } 17 | 18 | r_functions <- list( 19 | "begin" = quote(`{`), 20 | "set!" = quote(`<-`), 21 | "=" = quote(`==`), 22 | "eq?" = quote(`==`), 23 | "equal?" = identical, 24 | "not" = quote(`!`), 25 | "cons" = function(x, y) append(list(x), y), 26 | "car" = function(x) x[[1]], 27 | "cdr" = function(x) x[-1], 28 | "list?" = is.list, 29 | "null?" = function(x) identical(x, list()), 30 | "symbol?" = is.name, 31 | "number?" = is.numeric, 32 | "and" = function(a, b) if (x <- a) b else x, 33 | "or" = function(a, b) if (x <- a) x else b 34 | ) 35 | 36 | compile <- function(x) { 37 | if (is.character(x)) { # variable reference 38 | as.name(x) 39 | } else if (!is.list(x)) { # constant literal 40 | x 41 | } else if (length(x) == 0) { # empty list 42 | x 43 | } else if (identical(x[[1]], "define")) { 44 | if (is.list(x[[2]])) { # (define (var arg*) exp*) 45 | var <- x[[2]][[1]] 46 | args <- x[[2]][-1] 47 | exps <- x[-c(1, 2)] 48 | call("<-", as.name(var), compile(list("lambda", args, exps[[1]]))) 49 | } else { # (define var exp) 50 | var <- x[[2]] 51 | exp <- x[[3]] 52 | call("<-", as.name(var), compile(exp)) 53 | } 54 | } else if (identical(x[[1]], "lambda")) { # (lambda (var*) exp*) 55 | vars <- x[[2]] 56 | exps <- x[-c(1, 2)] 57 | args <- vector("list", length(vars)) 58 | names(args) <- as.character(vars) 59 | body <- as.call(c(quote(`{`), lapply(exps, compile))) 60 | call("function", as.pairlist(args), body) 61 | } else { # other functions 62 | r_func <- if (!is.list(x[[1]])) r_functions[[x[[1]]]] 63 | if (is.null(r_func)) { 64 | as.call(lapply(x, compile)) 65 | } else { 66 | as.call(c(r_func, lapply(x[-1], compile))) 67 | } 68 | } 69 | } 70 | -------------------------------------------------------------------------------- /R/parser.R: -------------------------------------------------------------------------------- 1 | #' Parse s-expression 2 | #' 3 | #' @param s s-expression 4 | parse <- function(s) { 5 | read_from(tokenize(s), 1)[[1]] 6 | } 7 | 8 | tokenize <- function(s) { 9 | s <- gsub("\\(", " ( ", s) 10 | s <- gsub("\\)", " ) ", s) 11 | s <- sub("^\\s+", "", s) 12 | 13 | strsplit(s, "\\s+")[[1]] 14 | } 15 | 16 | read_from <- function(tokens, i) { 17 | if (tokens[i] == "(") { 18 | L <- list() 19 | i <- i + 1 # skip "(" 20 | if (length(tokens) < i) stop("unexpected EOF while reading") 21 | while (tokens[i] != ")") { 22 | res <- read_from(tokens, i) 23 | L <- append(L, res[1]) 24 | i <- res[[2]] 25 | } 26 | i <- i + 1 # skip ")" 27 | return(list(L, i)) 28 | } else if (tokens[i] == ")") { 29 | stop("unexpected )") 30 | } else { 31 | return(list(atom(tokens[i]), i + 1)) 32 | } 33 | } 34 | 35 | atom <- function(token) { 36 | num <- suppressWarnings(as.numeric(token)) 37 | if (is.na(num)) token else num 38 | } 39 | -------------------------------------------------------------------------------- /R/repl.R: -------------------------------------------------------------------------------- 1 | #' Read–Eval–Print Loop 2 | #' 3 | #' @param prompt prompt 4 | #' @param envir environment 5 | #' @export 6 | repl <- function(prompt = "lisprr> ", envir = parent.frame()) { 7 | repeat { 8 | input <- readline(prompt) 9 | if (identical(input, "q")) { 10 | cat("bye.\n") 11 | break 12 | } 13 | val <- tryCatch(evaluate(input, envir), 14 | error = identity) 15 | str <- if (inherits(val, "error")) c(" ERROR:", val[[1]]) else to_string(val) 16 | cat(str) 17 | cat("\n") 18 | } 19 | } 20 | 21 | to_string <- function(exp) { 22 | if (is.list(exp)) { 23 | sprintf("(%s)", do.call(paste, lapply(exp, to_string))) 24 | } else { 25 | tryCatch(as.character(exp), 26 | error = function(e) sprintf("#<%s>", typeof(exp))) 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | ``` 15 | # lisprr 16 | 17 | 18 | [![Travis build status](https://travis-ci.org/igjit/lisprr.svg?branch=master)](https://travis-ci.org/igjit/lisprr) 19 | [![Codecov test coverage](https://codecov.io/gh/igjit/lisprr/branch/master/graph/badge.svg)](https://codecov.io/gh/igjit/lisprr?branch=master) 20 | 21 | 22 | A toy Lisp interpreter in R 23 | 24 | ## Installation 25 | 26 | You can install lisprr from github with: 27 | 28 | ``` r 29 | # install.packages("devtools") 30 | devtools::install_github("igjit/lisprr") 31 | ``` 32 | 33 | ## How to play 34 | 35 | ### evaluate 36 | 37 | ```{r} 38 | lisprr::evaluate("(+ 1 2)") 39 | ``` 40 | 41 | ```{r eval=FALSE} 42 | lisprr::evaluate("(plot (: 1 10))") 43 | ``` 44 | 45 | ### translate 46 | 47 | ```{r} 48 | lisprr::translate("(+ 1 2)") 49 | ``` 50 | 51 | ```{r} 52 | lisprr::translate("(define (add2 x) (+ x 2))") 53 | ``` 54 | 55 | ### repl 56 | 57 | ```lisp 58 | > lisprr::repl() 59 | lisprr> (: 1 10) 60 | 1 2 3 4 5 6 7 8 9 10 61 | lisprr> (define (add2 x) (+ x 2)) 62 | # 63 | lisprr> (add2 40) 64 | 42 65 | lisprr> (plot iris) 66 | 67 | lisprr> q 68 | bye. 69 | > 70 | ``` 71 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # lisprr 5 | 6 | 7 | 8 | [![Travis build 9 | status](https://travis-ci.org/igjit/lisprr.svg?branch=master)](https://travis-ci.org/igjit/lisprr) 10 | [![Codecov test 11 | coverage](https://codecov.io/gh/igjit/lisprr/branch/master/graph/badge.svg)](https://codecov.io/gh/igjit/lisprr?branch=master) 12 | 13 | 14 | A toy Lisp interpreter in R 15 | 16 | ## Installation 17 | 18 | You can install lisprr from github with: 19 | 20 | ``` r 21 | # install.packages("devtools") 22 | devtools::install_github("igjit/lisprr") 23 | ``` 24 | 25 | ## How to play 26 | 27 | ### evaluate 28 | 29 | ``` r 30 | lisprr::evaluate("(+ 1 2)") 31 | #> [1] 3 32 | ``` 33 | 34 | ``` r 35 | lisprr::evaluate("(plot (: 1 10))") 36 | ``` 37 | 38 | ### translate 39 | 40 | ``` r 41 | lisprr::translate("(+ 1 2)") 42 | #> 1 + 2 43 | ``` 44 | 45 | ``` r 46 | lisprr::translate("(define (add2 x) (+ x 2))") 47 | #> add2 <- function(x = NULL) { 48 | #> x + 2 49 | #> } 50 | ``` 51 | 52 | ### repl 53 | 54 | ``` lisp 55 | > lisprr::repl() 56 | lisprr> (: 1 10) 57 | 1 2 3 4 5 6 7 8 9 10 58 | lisprr> (define (add2 x) (+ x 2)) 59 | # 60 | lisprr> (add2 40) 61 | 42 62 | lisprr> (plot iris) 63 | 64 | lisprr> q 65 | bye. 66 | > 67 | ``` 68 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | patch: 10 | default: 11 | target: auto 12 | threshold: 1% 13 | -------------------------------------------------------------------------------- /man/evaluate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/evaluator.R 3 | \name{evaluate} 4 | \alias{evaluate} 5 | \title{Evaluate s-expression} 6 | \usage{ 7 | evaluate(s, ...) 8 | } 9 | \arguments{ 10 | \item{s}{s-expression} 11 | 12 | \item{...}{additional arguments} 13 | } 14 | \description{ 15 | Evaluate s-expression 16 | } 17 | -------------------------------------------------------------------------------- /man/parse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/parser.R 3 | \name{parse} 4 | \alias{parse} 5 | \title{Parse s-expression} 6 | \usage{ 7 | parse(s) 8 | } 9 | \arguments{ 10 | \item{s}{s-expression} 11 | } 12 | \description{ 13 | Parse s-expression 14 | } 15 | -------------------------------------------------------------------------------- /man/repl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/repl.R 3 | \name{repl} 4 | \alias{repl} 5 | \title{Read–Eval–Print Loop} 6 | \usage{ 7 | repl(prompt = "lisprr> ", envir = parent.frame()) 8 | } 9 | \arguments{ 10 | \item{prompt}{prompt} 11 | 12 | \item{envir}{environment} 13 | } 14 | \description{ 15 | Read–Eval–Print Loop 16 | } 17 | -------------------------------------------------------------------------------- /man/translate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/evaluator.R 3 | \name{translate} 4 | \alias{translate} 5 | \title{Translate s-expression to R} 6 | \usage{ 7 | translate(s) 8 | } 9 | \arguments{ 10 | \item{s}{s-expression} 11 | } 12 | \description{ 13 | Translate s-expression to R 14 | } 15 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(lisprr) 3 | 4 | test_check("lisprr") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-evaluator.R: -------------------------------------------------------------------------------- 1 | test_that("arithmetic operations", { 2 | expect_equal(evaluate("(+ 1 2)"), 3) 3 | expect_equal(evaluate("(* 2 3)"), 6) 4 | expect_equal(evaluate("(- 10 3)"), 7) 5 | expect_equal(evaluate("(/ 100 4)"), 25) 6 | }) 7 | 8 | test_that("list processing", { 9 | expect_equal(evaluate("(list)"), list()) 10 | expect_equal(evaluate("(list 1 2)"), list(1, 2)) 11 | expect_equal(evaluate("(car (list 10 20))"), 10) 12 | expect_equal(evaluate("(cdr (list 10 20 30))"), list(20, 30)) 13 | expect_equal(evaluate("(cons 1 (cons 2 (quote ())))"), list(1, 2)) 14 | expect_equal(evaluate("(cons (list 1 2) (quote ()))"), list(list(1, 2))) 15 | }) 16 | 17 | test_that("if", { 18 | expect_equal(evaluate("(if T 2 3)"), 2) 19 | expect_equal(evaluate("(if F 2 3)"), 3) 20 | expect_null(evaluate("(if F 2)")) 21 | }) 22 | 23 | test_that("quote", { 24 | expect_equal(evaluate("(quote abc)"), as.name("abc")) 25 | expect_equal(evaluate("(quote ())"), list()) 26 | }) 27 | 28 | test_that("begin", { 29 | expect_equal(evaluate("(begin 1)"), 1) 30 | expect_equal(evaluate("(begin 1 2 3)"), 3) 31 | }) 32 | 33 | test_that("lambda", { 34 | expect_equal(evaluate("((lambda (a b) (+ a b)) 1 2)"), 3) 35 | expect_equal(evaluate("((lambda (a) (+ a 1)) 1)"), 2) 36 | expect_equal(evaluate("((lambda (l) (cdr l)) (list 10 20))"), list(20)) 37 | expect_equal(evaluate("((lambda () (+ 1 2)))"), 3) 38 | }) 39 | 40 | test_that("list?", { 41 | expect_true(evaluate("(list? (list 1))")) 42 | expect_true(evaluate("(list? (list))")) 43 | expect_false(evaluate("(list? 1)")) 44 | }) 45 | 46 | test_that("null?", { 47 | expect_true(evaluate("(null? (list))")) 48 | expect_false(evaluate("(null? (list 1))")) 49 | expect_false(evaluate("(null? 1)")) 50 | }) 51 | 52 | test_that("symbol?", { 53 | expect_true(evaluate("(symbol? (quote x))")) 54 | expect_false(evaluate("(symbol? 1)")) 55 | }) 56 | 57 | test_that("number?", { 58 | expect_true(evaluate("(number? 1)")) 59 | expect_false(evaluate("(number? (list 1))")) 60 | }) 61 | 62 | test_that("=", { 63 | expect_true(evaluate("(= 1 1)")) 64 | expect_false(evaluate("(= 1 2)")) 65 | }) 66 | 67 | test_that("and", { 68 | expect_equal(evaluate("(and 1 2)"), 2) 69 | expect_false(evaluate("(and F 2)")) 70 | expect_false(evaluate("(and 1 F)")) 71 | expect_false(evaluate("(and F (stop))")) 72 | }) 73 | 74 | test_that("or", { 75 | expect_equal(evaluate("(or 1 2)"), 1) 76 | expect_equal(evaluate("(or F 2)"), 2) 77 | expect_false(evaluate("(or F F)")) 78 | expect_equal(evaluate("(or 1 (stop))"), 1) 79 | }) 80 | 81 | test_that("equal?", { 82 | expect_true(evaluate("(equal? (list 1 (list 2)) (list 1 (list 2)))")) 83 | }) 84 | 85 | test_that("set!", { 86 | env <- new.env() 87 | evaluate("(set! a 1)", env) 88 | expect_equal(env$a, 1) 89 | evaluate("(set! a 2)", env) 90 | expect_equal(env$a, 2) 91 | evaluate("(set! a (+ 1 2))", env) 92 | expect_equal(env$a, 3) 93 | }) 94 | 95 | test_that("define", { 96 | expect_equal(evaluate("(begin (define add2 (lambda (x) (+ x 2))) (add2 40))"), 42) 97 | expect_equal(evaluate("(begin (define add3 (lambda (x) (set! x (+ x 1)) (set! x (+ x 2)) x)) (add3 4))"), 7) 98 | expect_equal(evaluate("(begin (define (add2 x) (+ x 2)) (add2 40))"), 42) 99 | expect_equal(evaluate("(begin (define a 1) (set! a 100) a)"), 100) 100 | expect_equal(evaluate("(begin (define a 1) (set! a (list 2 3)) a)"), list(2, 3)) 101 | expect_equal(evaluate("(begin (define l (list 2 3 (list 4 5))) l)"), list(2, 3, list(4, 5))) 102 | 103 | env <- new.env() 104 | evaluate("(define (map f l) (if (null? l) (quote ()) (cons (f (car l)) (map f (cdr l)))))", env) 105 | expect_equal(evaluate("(map (lambda (x) (+ x 10)) (list 1 2 3))", env), list(11, 12, 13)) 106 | }) 107 | 108 | test_that("translate", { 109 | expect_equal(translate("(set! a 1)"), quote(a <- 1)) 110 | expect_equal(translate("(not a)"), quote(!a)) 111 | }) 112 | -------------------------------------------------------------------------------- /tests/testthat/test-parser.R: -------------------------------------------------------------------------------- 1 | test_that("parse", { 2 | expect_equal(parse("a"), "a") 3 | expect_equal(parse("1"), 1) 4 | expect_equal(parse("(1 2)"), list(1, 2)) 5 | expect_equal(parse("(1 (2))"), list(1, list(2))) 6 | expect_equal(parse("()"), list()) 7 | 8 | expect_error(parse("("), "unexpected EOF while reading") 9 | expect_error(parse(")"), "unexpected )") 10 | }) 11 | -------------------------------------------------------------------------------- /tests/testthat/test-repl.R: -------------------------------------------------------------------------------- 1 | test_that("repl", { 2 | readline_mock <- function(lines) { 3 | i <- 0 4 | function(prompt) lines[i <<- i + 1] 5 | } 6 | expect_output( 7 | with_mock(readline = readline_mock(c("(+ 1 2)", "q")), 8 | repl()), 9 | paste("3", "bye.", sep = "\n")) 10 | expect_output( 11 | with_mock(readline = readline_mock(c(")", "q")), 12 | repl()), 13 | "ERROR: unexpected )") 14 | }) 15 | 16 | test_that("to_string", { 17 | expect_equal(to_string(1), "1") 18 | expect_equal(to_string(list(1, list(2))), "(1 (2))") 19 | expect_equal(to_string(function(x) x), "#") 20 | }) 21 | --------------------------------------------------------------------------------