guile/reader.scm

   1 ;;  Copyright (C) 2015
   2 ;;      "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
   3 ;;  This file is free software: you can redistribute it and/or modify
   4 ;;  it under the terms of the GNU General Public License as published by
   5 ;;  the Free Software Foundation, either version 3 of the License, or
   6 ;;  (at your option) any later version.
   7
   8 ;;  This file is distributed in the hope that it will be useful,
   9 ;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 ;;  GNU General Public License for more details.
  12
  13 ;;  You should have received a copy of the GNU General Public License
  14 ;;  along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 (library (reader)
  17          (export read_str)
  18          (import (guile) (pcre) (ice-9 match) (srfi srfi-1)
  19                  (ice-9 regex) (types) (ice-9 format)))
  20
  21 (define (make-Reader tokens)
  22   (lambda (cmd)
  23     (case cmd
  24       ((next)
  25        (if (null? tokens)
  26            '()
  27            (let ((r (car tokens))) (set! tokens (cdr tokens)) r)))
  28       ((peek) (if (null? tokens) '() (car tokens)))
  29       (else (error "Reader: Invalid cmd!" cmd)))))
  30
  31 (define *token-re*
  32   (new-pcre "[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;[^\n]*|[^\\s\\[\\]{}('\"`,;)]*)"))
  33
  34 (define (tokenizer str)
  35   (filter (lambda (s) (and (not (string-null? s)) (not (string=? (substring s 0 1) ";"))))
  36           (pcre-search *token-re* str)))
  37
  38 (define (delim-read reader delim)
  39   (let lp((next (reader 'peek)) (ret '()))
  40     (cond
  41      ((null? next) (throw 'mal-error (format #f "expected '~a'" delim)))
  42      ((string=? next delim) (reader 'next) (reverse ret))
  43      (else
  44       (let* ((cur (read_form reader))
  45              (n (reader 'peek)))
  46         (lp n (cons cur ret)))))))
  47
  48 (define (read_list reader)
  49   (cond
  50    ((string=? ")" (reader 'peek))
  51     (reader 'next)
  52     '())
  53    (else (delim-read reader ")"))))
  54
  55 (define (read_vector reader)
  56   (cond
  57    ((string=? "]" (reader 'peek))
  58     (reader 'next)
  59     #())
  60    (else (list->vector (delim-read reader "]")))))
  61
  62 (define (read_hashmap reader)
  63   (define ht (make-hash-table))
  64   (define lst (delim-read reader "}"))
  65   (cond
  66    ((null? lst) ht)
  67    (else
  68     (let lp((k (car lst)))
  69       (cond
  70        ((null? k) ht)
  71        (else
  72         (when (null? (cdr lst))
  73               (throw 'mal-error "read_hashmap: lack of value" k))
  74         (let ((v (cadr lst)))
  75           (hash-set! ht k v)
  76           (lp (cddr lst)))))))))
  77
  78 (define (read_atom reader)
  79   (define (->str s)
  80     (string-sub
  81      (string-sub s "\\\\\"" "\"")
  82      "\\\\\n" "\n"))
  83   (let ((token (reader 'next)))
  84     (cond
  85      ((string-match "^-?[0-9][0-9.]*$" token)
  86       => (lambda (m) (string->number (match:substring m 0))))
  87      ((string-match "^\"(.*)(.)$" token)
  88       => (lambda (m)
  89            (if (string=? "\"" (match:substring m 2))
  90                (->str (match:substring m 1))
  91                (throw 'mal-error "expected '\"'"))))
  92      ((string-match "^:(.*)" token)
  93       => (lambda (m) (_keyword (match:substring m 1))))
  94      ((string=? "nil" token) nil)
  95      ((string=? "true" token) #t)
  96      ((string=? "false" token) #f)
  97      (else (string->symbol token)))))
  98
  99 (define (read_form reader)
 100   (define (next) (reader 'next))
 101   (define (more) (read_form reader))
 102   (match (reader 'peek)
 103     (() (throw 'mal-error "blank line")) ; FIXME: what should be returned?
 104     ("'" (next) (list 'quote (more)))
 105     ("`" (next) (list 'quasiquote (more)))
 106     ("~" (next) (list 'unquote (more)))
 107     ("~@" (next) (list 'splice-unquote (more)))
 108     ("^" (next) (let ((meta (more))) `(with-meta ,(more) ,meta)))
 109     ("@" (next) `(deref ,(more)))
 110     (")" (next) (throw 'mal-error "unexpected ')'"))
 111     ("(" (next) (read_list reader))
 112     ("]" (throw 'mal-error "unexpected ']'"))
 113     ("[" (next) (read_vector reader))
 114     ("}" (throw 'mal-error "unexpected '}'"))
 115     ("{" (next) (read_hashmap reader))
 116     ("" (next) (read_form reader))
 117     (else (read_atom reader))))
 118
 119 (define (read_str str)
 120   (if (eof-object? str)
 121       str
 122       (let ((tokens (tokenizer str)))
 123         (read_form (make-Reader (if (null? tokens) (list str) tokens))))))