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((next lst))
  69       (cond
  70        ((null? next) ht)
  71        (else
  72         (when (null? (cdr next))
  73           (throw 'mal-error
  74                  (format #f "read_hashmap: '~a' lack of value" (car next))))
  75         (let ((k (car next))
  76               (v (cadr next)))
  77           (hash-set! ht k v)
  78           (lp (cddr next)))))))))
  79
  80 (define (read_atom reader)
  81   (define (->str s)
  82     (string-sub
  83      (string-sub
  84       (string-sub s "\\\\\"" "\"")
  85       "\\\\n" "\n")
  86      "\\\\\\\\" "\\"))
  87   (let ((token (reader 'next)))
  88     (cond
  89      ((string-match "^-?[0-9][0-9.]*$" token)
  90       => (lambda (m) (string->number (match:substring m 0))))
  91      ((string-match "^\"(.*)(.)$" token)
  92       => (lambda (m)
  93            (if (string=? "\"" (match:substring m 2))
  94                (->str (match:substring m 1))
  95                (throw 'mal-error "expected '\"'"))))
  96      ((string-match "^:(.*)" token)
  97       => (lambda (m) (string->keyword (match:substring m 1))))
  98      ((string=? "nil" token) nil)
  99      ((string=? "true" token) #t)
 100      ((string=? "false" token) #f)
 101      (else (string->symbol token)))))
 102
 103 (define (read_form reader)
 104   (define (clean x)
 105     (if (string? x)
 106         (string-trim-both
 107          x
 108          (lambda (c) (char-set-contains? char-set:whitespace c)))
 109         x))
 110   (define (next) (reader 'next))
 111   (define (more) (read_form reader))
 112   (match (clean (reader 'peek))
 113     (() (throw 'mal-error "blank line")) ; FIXME: what should be returned?
 114     ("'" (next) (list 'quote (more)))
 115     ("`" (next) (list 'quasiquote (more)))
 116     ("~" (next) (list 'unquote (more)))
 117     ("~@" (next) (list 'splice-unquote (more)))
 118     ("^" (next) (let ((meta (more))) `(with-meta ,(more) ,meta)))
 119     ("@" (next) `(deref ,(more)))
 120     (")" (next) (throw 'mal-error "unexpected ')'"))
 121     ("(" (next) (read_list reader))
 122     ("]" (throw 'mal-error "unexpected ']'"))
 123     ("[" (next) (read_vector reader))
 124     ("}" (throw 'mal-error "unexpected '}'"))
 125     ("{" (next) (read_hashmap reader))
 126     ("" (next) (read_form reader))
 127     (else (read_atom reader))))
 128
 129 (define (read_str str)
 130   (if (eof-object? str)
 131       str
 132       (let* ((tokens (tokenizer str))
 133              (t (if (null? tokens)
 134                     (if (char=? (string-ref str 0) #\;)
 135                         '()
 136                         (list str))
 137                     tokens)))
 138         (read_form (make-Reader t)))))