diff --git a/cmake/FindFLEX.cmake b/cmake/FindFLEX.cmake deleted file mode 100644 index c56e8eda..00000000 --- a/cmake/FindFLEX.cmake +++ /dev/null @@ -1,179 +0,0 @@ -# - Find flex executable and provides a macro to generate custom build rules -# -# The module defines the following variables: -# FLEX_FOUND - true is flex executable is found -# FLEX_EXECUTABLE - the path to the flex executable -# FLEX_VERSION - the version of flex -# FLEX_LIBRARIES - The flex libraries -# -# The minimum required version of flex can be specified using the -# standard syntax, e.g. FIND_PACKAGE(FLEX 2.5.13) -# -# -# If flex is found on the system, the module provides the macro: -# FLEX_TARGET(Name FlexInput FlexOutput [COMPILE_FLAGS ]) -# which creates a custom command to generate the file from -# the file. If COMPILE_FLAGS option is specified, the next -# parameter is added to the flex command line. Name is an alias used to -# get details of this custom command. Indeed the macro defines the -# following variables: -# FLEX_${Name}_DEFINED - true is the macro ran successfully -# FLEX_${Name}_OUTPUTS - the source file generated by the custom rule, an -# alias for FlexOutput -# FLEX_${Name}_INPUT - the flex source file, an alias for ${FlexInput} -# -# Flex scanners oftenly use tokens defined by Bison: the code generated -# by Flex depends of the header generated by Bison. This module also -# defines a macro: -# ADD_FLEX_BISON_DEPENDENCY(FlexTarget BisonTarget) -# which adds the required dependency between a scanner and a parser -# where and are the first parameters of -# respectively FLEX_TARGET and BISON_TARGET macros. -# -# ==================================================================== -# Example: -# -# find_package(BISON) -# find_package(FLEX) -# -# BISON_TARGET(MyParser parser.y ${CMAKE_CURRENT_BINARY_DIR}/parser.cpp -# FLEX_TARGET(MyScanner lexer.l ${CMAKE_CURRENT_BIANRY_DIR}/lexer.cpp) -# ADD_FLEX_BISON_DEPENDENCY(MyScanner MyParser) -# -# include_directories(${CMAKE_CURRENT_BINARY_DIR}) -# add_executable(Foo -# Foo.cc -# ${BISON_MyParser_OUTPUTS} -# ${FLEX_MyScanner_OUTPUTS} -# ) -# ==================================================================== - -#============================================================================= -# Copyright 2009 Kitware, Inc. -# Copyright 2006 Tristan Carel -# Modified 2010 by Jon Siwek, backporting for CMake 2.6 compat -# -# Distributed under the OSI-approved BSD License (the "License"): -# CMake - Cross Platform Makefile Generator -# Copyright 2000-2009 Kitware, Inc., Insight Software Consortium -# All rights reserved. - -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# -# * Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# -# * Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# * Neither the names of Kitware, Inc., the Insight Software Consortium, -# nor the names of their contributors may be used to endorse or promote -# products derived from this software without specific prior written -# permission. -# -# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -# HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -# -# This software is distributed WITHOUT ANY WARRANTY; without even the -# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -# See the License for more information. -#============================================================================= - -FIND_PROGRAM(FLEX_EXECUTABLE flex DOC "path to the flex executable") -MARK_AS_ADVANCED(FLEX_EXECUTABLE) - -FIND_LIBRARY(FL_LIBRARY NAMES fl - DOC "path to the fl library") -MARK_AS_ADVANCED(FL_LIBRARY) -SET(FLEX_LIBRARIES ${FL_LIBRARY}) - -IF(FLEX_EXECUTABLE) - - EXECUTE_PROCESS(COMMAND ${FLEX_EXECUTABLE} --version - OUTPUT_VARIABLE FLEX_version_output - ERROR_VARIABLE FLEX_version_error - RESULT_VARIABLE FLEX_version_result - OUTPUT_STRIP_TRAILING_WHITESPACE) - IF(NOT ${FLEX_version_result} EQUAL 0) - IF(FLEX_FIND_REQUIRED) - MESSAGE(SEND_ERROR "Command \"${FLEX_EXECUTABLE} --version\" failed with output:\n${FLEX_version_output}\n${FLEX_version_error}") - ELSE() - MESSAGE("Command \"${FLEX_EXECUTABLE} --version\" failed with output:\n${FLEX_version_output}\n${FLEX_version_error}\nFLEX_VERSION will not be available") - ENDIF() - ELSE() - STRING(REGEX REPLACE "^flex (.*)$" "\\1" - FLEX_VERSION "${FLEX_version_output}") - ENDIF() - - #============================================================ - # FLEX_TARGET (public macro) - #============================================================ - # - MACRO(FLEX_TARGET Name Input Output) - SET(FLEX_TARGET_usage "FLEX_TARGET( [COMPILE_FLAGS ]") - IF(${ARGC} GREATER 3) - IF(${ARGC} EQUAL 5) - IF("${ARGV3}" STREQUAL "COMPILE_FLAGS") - SET(FLEX_EXECUTABLE_opts "${ARGV4}") - SEPARATE_ARGUMENTS(FLEX_EXECUTABLE_opts) - ELSE() - MESSAGE(SEND_ERROR ${FLEX_TARGET_usage}) - ENDIF() - ELSE() - MESSAGE(SEND_ERROR ${FLEX_TARGET_usage}) - ENDIF() - ENDIF() - - ADD_CUSTOM_COMMAND(OUTPUT ${Output} - COMMAND ${FLEX_EXECUTABLE} - ARGS ${FLEX_EXECUTABLE_opts} -o${Output} ${Input} - DEPENDS ${Input} - COMMENT "[FLEX][${Name}] Building scanner with flex ${FLEX_VERSION}" - WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) - - SET(FLEX_${Name}_DEFINED TRUE) - SET(FLEX_${Name}_OUTPUTS ${Output}) - SET(FLEX_${Name}_INPUT ${Input}) - SET(FLEX_${Name}_COMPILE_FLAGS ${FLEX_EXECUTABLE_opts}) - ENDMACRO(FLEX_TARGET) - #============================================================ - - - #============================================================ - # ADD_FLEX_BISON_DEPENDENCY (public macro) - #============================================================ - # - MACRO(ADD_FLEX_BISON_DEPENDENCY FlexTarget BisonTarget) - - IF(NOT FLEX_${FlexTarget}_OUTPUTS) - MESSAGE(SEND_ERROR "Flex target `${FlexTarget}' does not exists.") - ENDIF() - - IF(NOT BISON_${BisonTarget}_OUTPUT_HEADER) - MESSAGE(SEND_ERROR "Bison target `${BisonTarget}' does not exists.") - ENDIF() - - SET_SOURCE_FILES_PROPERTIES(${FLEX_${FlexTarget}_OUTPUTS} - PROPERTIES OBJECT_DEPENDS ${BISON_${BisonTarget}_OUTPUT_HEADER}) - ENDMACRO(ADD_FLEX_BISON_DEPENDENCY) - #============================================================ - -ENDIF(FLEX_EXECUTABLE) - -INCLUDE(FindPackageHandleStandardArgs) -FIND_PACKAGE_HANDLE_STANDARD_ARGS(FLEX FLEX_EXECUTABLE - FLEX_VERSION) - -# FindFLEX.cmake ends here diff --git a/extlib/xfile b/extlib/xfile index c7d08eb1..45cad164 160000 --- a/extlib/xfile +++ b/extlib/xfile @@ -1 +1 @@ -Subproject commit c7d08eb1abc829f3380991d3754a1ef6ce539c4d +Subproject commit 45cad164afcd0ad3f83286f39ae947c0e595c077 diff --git a/include/picrin.h b/include/picrin.h index d194de1f..0e673dca 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -100,6 +100,8 @@ typedef struct { pic_value lib_tbl; struct pic_lib *lib; + xhash rlabels; + jmp_buf *jmp; struct pic_error *err; struct pic_jmpbuf *try_jmps; @@ -150,7 +152,8 @@ bool pic_interned_p(pic_state *, pic_sym); char *pic_strdup(pic_state *, const char *); char *pic_strndup(pic_state *, const char *, size_t); -pic_value pic_read(pic_state *, const char *); +pic_value pic_read(pic_state *, struct pic_port *); +pic_value pic_read_cstr(pic_state *, const char *); pic_list pic_parse_file(pic_state *, FILE *); /* #f for incomplete input */ pic_list pic_parse_cstr(pic_state *, const char *); @@ -178,7 +181,7 @@ struct pic_lib *pic_find_library(pic_state *, pic_value); #define pic_deflibrary_helper__(i, prev_lib, spec) \ for (int i = 0; ! i; ) \ for (struct pic_lib *prev_lib; ! i; ) \ - for ((prev_lib = pic->lib), pic_make_library(pic, pic_read(pic, spec)), pic_in_library(pic, pic_read(pic, spec)); ! i++; pic->lib = prev_lib) + for ((prev_lib = pic->lib), pic_make_library(pic, pic_read_cstr(pic, spec)), pic_in_library(pic, pic_read_cstr(pic, spec)); ! i++; pic->lib = prev_lib) void pic_import(pic_state *, pic_value); void pic_export(pic_state *, pic_sym); diff --git a/include/picrin/parse.h b/include/picrin/parse.h deleted file mode 100644 index 0451d201..00000000 --- a/include/picrin/parse.h +++ /dev/null @@ -1,46 +0,0 @@ -/** - * See Copyright Notice in picrin.h - */ - -#ifndef PICRIN_PARSE_H__ -#define PICRIN_PARSE_H__ - -#if defined(__cplusplus) -extern "C" { -#endif - -enum { - tEOF = 0, - tLABEL_SET, tLABEL_REF, tDATUM_COMMENT, - tLPAREN, tRPAREN, tLBRACKET, tRBRACKET, tDOT, tVPAREN, - tQUOTE, tQUASIQUOTE, tUNQUOTE, tUNQUOTE_SPLICING, - tINT, tBOOLEAN, - tFLOAT, - tSYMBOL, tSTRING, - tCHAR, - tBYTEVECTOR, -}; - -typedef union YYSTYPE { - int i; - double f; - struct { - char *dat; - size_t len; - } buf; - char c; -} YYSTYPE; - -struct parser_control { - pic_state *pic; - YYSTYPE yylval; - xhash labels; - jmp_buf jmp; - const char *msg; -}; - -#if defined(__cplusplus) -} -#endif - -#endif diff --git a/include/picrin/port.h b/include/picrin/port.h index 9fabf8ed..e51d8759 100644 --- a/include/picrin/port.h +++ b/include/picrin/port.h @@ -37,6 +37,7 @@ struct pic_port *pic_stdin(pic_state *); struct pic_port *pic_stdout(pic_state *); struct pic_port *pic_stderr(pic_state *); +struct pic_port *pic_open_input_string(pic_state *, const char *); struct pic_port *pic_open_output_string(pic_state *); struct pic_string *pic_get_output_string(pic_state *, struct pic_port *); diff --git a/include/picrin/value.h b/include/picrin/value.h index 44dd0763..a569cc71 100644 --- a/include/picrin/value.h +++ b/include/picrin/value.h @@ -158,6 +158,7 @@ typedef struct pic_blob pic_blob; #define pic_int_p(v) (pic_vtype(v) == PIC_VTYPE_INT) #define pic_sym_p(v) (pic_vtype(v) == PIC_VTYPE_SYMBOL) #define pic_char_p(v) (pic_vtype(v) == PIC_VTYPE_CHAR) +#define pic_eof_p(v) (pic_vtype(v) == PIC_VTYPE_EOF) #define pic_test(v) (! pic_false_p(v)) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 7a727e9b..9318f442 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -1,8 +1,3 @@ -# flex -find_package(FLEX REQUIRED) -flex_target(scan src/scan.l ${PROJECT_SOURCE_DIR}/src/lex.yy.c COMPILE_FLAGS --header-file="src/lex.yy.h") -set_directory_properties(PROPERTIES ADDITIONAL_MAKE_CLEAN_FILES ${PROJECT_SOURCE_DIR}/src/lex.yy.h) - # xfile set(XFILE_SOURCES extlib/xfile/xfile.c) @@ -18,7 +13,7 @@ add_custom_command( # build! file(GLOB PICRIN_SOURCES ${PROJECT_SOURCE_DIR}/src/*.c) -add_library(picrin SHARED ${PICRIN_SOURCES} ${PICLIB_SOURCE} ${FLEX_scan_OUTPUTS} ${XFILE_SOURCES} ${PICRIN_CONTRIB_SOURCES}) +add_library(picrin SHARED ${PICRIN_SOURCES} ${PICLIB_SOURCE} ${XFILE_SOURCES} ${PICRIN_CONTRIB_SOURCES}) target_link_libraries(picrin m ${PICRIN_CONTRIB_LIBRARIES}) # install diff --git a/src/codegen.c b/src/codegen.c index f18062b0..d097896f 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -68,7 +68,7 @@ new_analyze_state(pic_state *pic) state->pic = pic; state->scope = NULL; - stdlib = pic_find_library(pic, pic_read(pic, "(scheme base)")); + stdlib = pic_find_library(pic, pic_read_cstr(pic, "(scheme base)")); /* native VM procedures */ register_renamed_symbol(pic, state, rCONS, stdlib, "cons"); diff --git a/src/load.c b/src/load.c index b1fcf39a..f4b4db73 100644 --- a/src/load.c +++ b/src/load.c @@ -14,7 +14,7 @@ pic_load_cstr(pic_state *pic, const char *src) exprs = pic_parse_cstr(pic, src); if (pic_undef_p(exprs)) { - pic_error(pic, "load: unexpected EOF"); + pic_errorf(pic, "load: read failure (%s)", pic_errmsg(pic)); } pic_for_each (v, exprs) { @@ -48,7 +48,7 @@ pic_load(pic_state *pic, const char *fn) exprs = pic_parse_file(pic, file); if (pic_undef_p(exprs)) { - pic_error(pic, "load: unexpected EOF"); + pic_errorf(pic, "load: read failure (%s)", pic_errmsg(pic)); } pic_for_each (v, exprs) { diff --git a/src/port.c b/src/port.c index 419b8aee..168b5cce 100644 --- a/src/port.c +++ b/src/port.c @@ -54,6 +54,23 @@ port_new_stdport(pic_state *pic, xFILE *file, short dir) return pic_obj_value(port); } +struct pic_port * +pic_open_input_string(pic_state *pic, const char *str) +{ + struct pic_port *port; + + port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT); + port->file = xmopen(); + port->flags = PIC_PORT_IN | PIC_PORT_TEXT; + port->status = PIC_PORT_OPEN; + + xfputs(str, port->file); + xfflush(port->file); + xrewind(port->file); + + return port; +} + struct pic_port * pic_open_output_string(pic_state *pic) { @@ -70,19 +87,20 @@ pic_open_output_string(pic_state *pic) struct pic_string * pic_get_output_string(pic_state *pic, struct pic_port *port) { - long endpos; + long size; char *buf; /* get endpos */ xfflush(port->file); - endpos = xftell(port->file); + size = xftell(port->file); xrewind(port->file); /* copy to buf */ - buf = (char *)pic_alloc(pic, endpos); - xfread(buf, 1, endpos, port->file); + buf = (char *)pic_alloc(pic, size + 1); + buf[size] = 0; + xfread(buf, size, 1, port->file); - return pic_str_new(pic, buf, endpos); + return pic_str_new(pic, buf, size); } void @@ -268,14 +286,7 @@ pic_port_open_input_string(pic_state *pic) pic_get_args(pic, "z", &str); - port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT); - port->file = xmopen(); - port->flags = PIC_PORT_IN | PIC_PORT_TEXT; - port->status = PIC_PORT_OPEN; - - xfputs(str, port->file); - xfflush(port->file); - xrewind(port->file); + port = pic_open_input_string(pic, str); return pic_obj_value(port); } diff --git a/src/read.c b/src/read.c index 6f1d39ba..de8edaae 100644 --- a/src/read.c +++ b/src/read.c @@ -2,84 +2,428 @@ * See Copyright Notice in picrin.h */ +#include +#include #include "picrin.h" -#include "picrin/parse.h" +#include "picrin/error.h" #include "picrin/pair.h" #include "picrin/string.h" #include "picrin/vector.h" #include "picrin/blob.h" #include "picrin/port.h" -#define YY_NO_UNISTD_H -#include "lex.yy.h" +typedef pic_value (*read_func_t)(pic_state *, struct pic_port *, char); -static pic_value read(int, yyscan_t); +static pic_value read(pic_state *pic, struct pic_port *port, char c); -#define pic (yyget_extra(scanner)->pic) -#define yylval (yyget_extra(scanner)->yylval) -#define yylabels (yyget_extra(scanner)->labels) -#define yymsg (yyget_extra(scanner)->msg) -#define yyjmp (yyget_extra(scanner)->jmp) - -static void -error(const char *msg, yyscan_t scanner) +static noreturn void +read_error(pic_state *pic, const char *msg) { - yymsg = msg; - longjmp(yyjmp, 1); + pic_error(pic, msg); } -static int -gettok(yyscan_t scanner) +static char +skip(struct pic_port *port, char c) { - int tok; - - while ((tok = yylex(scanner)) == tDATUM_COMMENT) { - read(gettok(scanner), scanner); /* discard */ + while (isspace(c)) { + c = xfgetc(port->file); } - return tok; + return c; +} + +static char +next(struct pic_port *port) +{ + return xfgetc(port->file); +} + +static char +peek(struct pic_port *port) +{ + char c; + + xungetc((c = xfgetc(port->file)), port->file); + + return c; } static pic_value -read_label_set(int i, yyscan_t scanner) +read_comment(pic_state *pic, struct pic_port *port, char c) +{ + UNUSED(pic); + + do { + c = next(port); + } while (! (c == EOF || c == '\n')); + + return pic_undef_value(); +} + +static pic_value +read_block_comment(pic_state *pic, struct pic_port *port, char c) +{ + char x, y; + int i; + + UNUSED(pic); + UNUSED(c); + + x = next(port); + y = next(port); + + i = 1; + while (x != EOF && y != EOF && i > 0) { + if (x == '|' && y == '#') { + i--; + } + if (x == '#' && y == '|') { + i++; + } + x = y; + y = next(port); + } + + return pic_undef_value(); +} + +static pic_value +read_datum_comment(pic_state *pic, struct pic_port *port, char c) +{ + UNUSED(c); + + read(pic, port, next(port)); + + return pic_undef_value(); +} + +static pic_value +read_quote(pic_state *pic, struct pic_port *port, char c) +{ + UNUSED(c); + + return pic_list2(pic, pic_sym_value(pic->sQUOTE), read(pic, port, next(port))); +} + +static pic_value +read_quasiquote(pic_state *pic, struct pic_port *port, char c) +{ + UNUSED(c); + + return pic_list2(pic, pic_sym_value(pic->sQUASIQUOTE), read(pic, port, next(port))); +} + +static pic_value +read_comma(pic_state *pic, struct pic_port *port, char c) +{ + c = next(port); + + if (c == '@') { + return pic_list2(pic, pic_sym_value(pic->sUNQUOTE_SPLICING), read(pic, port, next(port))); + } else { + return pic_list2(pic, pic_sym_value(pic->sUNQUOTE), read(pic, port, c)); + } +} + +static pic_value +read_symbol(pic_state *pic, struct pic_port *port, char c) +{ + static const char TRAIL_SYMBOL[] = "+/*!$%&:@^~?<=>_.-"; + size_t len; + char *buf; + pic_sym sym; + + len = 0; + buf = NULL; + + do { + if (len != 0) { + c = next(port); + } + len += 1; + buf = pic_realloc(pic, buf, len); + buf[len - 1] = c; + } while (isalnum(peek(port)) || strchr(TRAIL_SYMBOL, peek(port))); + + buf[len] = '\0'; + sym = pic_intern_cstr(pic, buf); + pic_free(pic, buf); + + return pic_sym_value(sym); +} + +static int64_t +read_uinteger(pic_state *pic, struct pic_port *port, char c) +{ + int64_t n; + + c = skip(port, c); + + if (! isdigit(c)) { + read_error(pic, "expected one or more digits"); + } + + n = c - '0'; + while (isdigit(c = peek(port))) { + next(port); + n = n * 10 + c - '0'; + } + + return n; +} + +static pic_value +read_number(pic_state *pic, struct pic_port *port, char c) +{ + int64_t i, j; + + i = read_uinteger(pic, port, c); + + if (peek(port) == '.') { + next(port); + j = read_uinteger(pic, port, next(port)); + return pic_float_value(i + (double)j * pow(10, -snprintf(NULL, 0, "%lld", j))); + } + else { + return pic_int_value(i); + } + +} + +static pic_value +negate(pic_value n) +{ + if (pic_int_p(n)) { + return pic_int_value(-pic_int(n)); + } else { + return pic_float_value(-pic_float(n)); + } +} + +static pic_value +read_minus(pic_state *pic, struct pic_port *port, char c) +{ + static const char DIGITS[] = "0123456789"; + + /* TODO: -inf.0, -nan.0 */ + + if (strchr(DIGITS, peek(port))) { + return negate(read_number(pic, port, c)); + } + else { + return read_symbol(pic, port, c); + } +} + +static pic_value +read_plus(pic_state *pic, struct pic_port *port, char c) +{ + static const char DIGITS[] = "0123456789"; + + /* TODO: +inf.0, +nan.0 */ + + if (strchr(DIGITS, peek(port))) { + return read_number(pic, port, c); + } + else { + return read_symbol(pic, port, c); + } +} + +static pic_value +read_boolean(pic_state *pic, struct pic_port *port, char c) +{ + UNUSED(pic); + UNUSED(port); + + /* TODO: support #true and #false */ + + if (c == 't') { + return pic_true_value(); + } else { + return pic_false_value(); + } +} + +static pic_value +read_char(pic_state *pic, struct pic_port *port, char c) +{ + UNUSED(pic); + UNUSED(c); + + /* TODO: #\alart, #\space, so on and so on */ + + return pic_char_value(next(port)); +} + +static pic_value +read_string(pic_state *pic, struct pic_port *port, char c) +{ + char *buf; + size_t size, cnt; + pic_str *str; + + size = 256; + buf = pic_alloc(pic, size); + cnt = 0; + + /* TODO: intraline whitespaces */ + + while ((c = next(port)) != '"') { + if (c == '\\') { + switch (c = next(port)) { + case 'a': c = '\a'; break; + case 'b': c = '\b'; break; + case 't': c = '\t'; break; + case 'n': c = '\n'; break; + case 'r': c = '\r'; break; + } + } + buf[cnt++] = c; + if (cnt >= size) { + buf = pic_realloc(pic, buf, size *= 2); + } + } + buf[cnt] = '\0'; + + str = pic_str_new(pic, buf, size); + pic_free(pic, buf); + return pic_obj_value(str); +} + +static pic_value +read_unsigned_blob(pic_state *pic, struct pic_port *port, char c) +{ + int nbits, n; + size_t len; + char *buf; + pic_blob *blob; + + nbits = 0; + + while (isdigit(c = next(port))) { + nbits = 10 * nbits + c - '0'; + } + + if (nbits != 8) { + read_error(pic, "unsupported bytevector bit width"); + } + + if (c != '(') { + read_error(pic, "expected '(' character"); + } + + len = 0; + buf = NULL; + c = next(port); + while ((c = skip(port, c)) != ')') { + n = read_uinteger(pic, port, c); + if (n < 0 || (1 << nbits) <= n) { + read_error(pic, "invalid element in bytevector literal"); + } + len += 1; + buf = pic_realloc(pic, buf, len); + buf[len - 1] = n; + c = next(port); + } + + blob = pic_blob_new(pic, buf, len); + pic_free(pic, buf); + return pic_obj_value(blob); +} + +static pic_value +read_pair(pic_state *pic, struct pic_port *port, char c) +{ + char tOPEN = c, tCLOSE = (tOPEN == '(') ? ')' : ']'; + pic_value car, cdr; + + c = skip(port, ' '); + + if (c == tCLOSE) { + return pic_nil_value(); + } + if (c == '.' && strchr("()#;,|'\" \t\n\r", peek(port)) != NULL) { + cdr = read(pic, port, next(port)); + + if ((c = skip(port, ' ')) != tCLOSE) { + read_error(pic, "unmatched parenthesis"); + } + return cdr; + } + else { + car = read(pic, port, c); + cdr = read_pair(pic, port, tOPEN); /* FIXME: don't use recursion */ + return pic_cons(pic, car, cdr); + } +} + +static pic_value +read_vector(pic_state *pic, struct pic_port *port, char c) { - int tok; pic_value val; - switch (tok = gettok(scanner)) { - case tLPAREN: - case tLBRACKET: + c = next(port); + + val = pic_nil_value(); + while ((c = skip(port, c)) != ')') { + val = pic_cons(pic, read(pic, port, c), val); + c = next(port); + } + return pic_obj_value(pic_vec_new_from_list(pic, pic_reverse(pic, val))); +} + +static pic_value +read_label_set(pic_state *pic, struct pic_port *port, int i) +{ + pic_value val; + char c; + + switch (c = skip(port, ' ')) { + case '(': case '[': { pic_value tmp; val = pic_cons(pic, pic_none_value(), pic_none_value()); - xh_put_int(&yylabels, i, &val); + xh_put_int(&pic->rlabels, i, &val); - tmp = read(tok, scanner); + tmp = read(pic, port, c); pic_pair_ptr(val)->car = pic_car(pic, tmp); pic_pair_ptr(val)->cdr = pic_cdr(pic, tmp); return val; } - case tVPAREN: + case '#': { - pic_vec *tmp; + bool vect; - val = pic_obj_value(pic_vec_new(pic, 0)); + if (peek(port) == '(') { + vect = true; + } else { + vect = false; + } - xh_put_int(&yylabels, i, &val); + if (vect) { + pic_vec *tmp; - tmp = pic_vec_ptr(read(tok, scanner)); - SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data); - SWAP(size_t, tmp->len, pic_vec_ptr(val)->len); + val = pic_obj_value(pic_vec_new(pic, 0)); - return val; + xh_put_int(&pic->rlabels, i, &val); + + tmp = pic_vec_ptr(read(pic, port, c)); + SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data); + SWAP(size_t, tmp->len, pic_vec_ptr(val)->len); + + return val; + } + + FALLTHROUGH; } default: { - val = read(tok, scanner); + val = read(pic, port, c); - xh_put_int(&yylabels, i, &val); + xh_put_int(&pic->rlabels, i, &val); return val; } @@ -87,239 +431,188 @@ read_label_set(int i, yyscan_t scanner) } static pic_value -read_label_ref(int i, yyscan_t scanner) +read_label_ref(pic_state *pic, struct pic_port *port, int i) { xh_entry *e; - e = xh_get_int(&yylabels, i); + UNUSED(port); + + e = xh_get_int(&pic->rlabels, i); if (! e) { - error("label of given index not defined", scanner); + read_error(pic, "label of given index not defined"); } return xh_val(e, pic_value); } static pic_value -read_pair(int tOPEN, yyscan_t scanner) +read_label(pic_state *pic, struct pic_port *port, char c) { - int tok, tCLOSE = (tOPEN == tLPAREN) ? tRPAREN : tRBRACKET; - pic_value car, cdr; + int i; - tok = gettok(scanner); - if (tok == tCLOSE) { - return pic_nil_value(); - } - if (tok == tDOT) { - cdr = read(gettok(scanner), scanner); + i = 0; + do { + i = i * 10 + c; + } while (isdigit(c = next(port))); - if (gettok(scanner) != tCLOSE) { - error("unmatched parenthesis", scanner); - } - return cdr; + if (c == '=') { + return read_label_set(pic, port, i); } - else { - car = read(tok, scanner); - cdr = read_pair(tOPEN, scanner); - return pic_cons(pic, car, cdr); + if (c == '#') { + return read_label_ref(pic, port, i); } -} - -static pic_vec * -read_vect(yyscan_t scanner) -{ - int tok; - pic_value val; - - val = pic_nil_value(); - while ((tok = gettok(scanner)) != tRPAREN) { - val = pic_cons(pic, read(tok, scanner), val); - } - return pic_vec_new_from_list(pic, pic_reverse(pic, val)); + read_error(pic, "broken label expression"); } static pic_value -read_abbrev(pic_sym sym, yyscan_t scanner) +read_dispatch(pic_state *pic, struct pic_port *port, char c) { - return pic_cons(pic, pic_sym_value(sym), pic_cons(pic, read(gettok(scanner), scanner), pic_nil_value())); + c = next(port); + + switch (c) { + case '!': + return read_comment(pic, port, c); + case '|': + return read_block_comment(pic, port, c); + case ';': + return read_datum_comment(pic, port, c); + case 't': case 'f': + return read_boolean(pic, port, c); + case '\\': + return read_char(pic, port, c); + case '(': + return read_vector(pic, port, c); + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + return read_label(pic, port, c); + case 'u': + return read_unsigned_blob(pic, port, c); + default: + read_error(pic, "unexpected dispatch character"); + } } static pic_value -read_datum(int tok, yyscan_t scanner) +read_nullable(pic_state *pic, struct pic_port *port, char c) { - pic_value val; + c = skip(port, c); - switch (tok) { - case tLABEL_SET: - return read_label_set(yylval.i, scanner); - - case tLABEL_REF: - return read_label_ref(yylval.i, scanner); - - case tSYMBOL: - return pic_symbol_value(pic_intern(pic, yylval.buf.dat, yylval.buf.len)); - - case tINT: - return pic_int_value(yylval.i); - - case tFLOAT: - return pic_float_value(yylval.f); - - case tBOOLEAN: - return pic_bool_value(yylval.i); - - case tCHAR: - return pic_char_value(yylval.c); - - case tSTRING: - val = pic_obj_value(pic_str_new(pic, yylval.buf.dat, yylval.buf.len)); - pic_free(pic, yylval.buf.dat); - return val; - - case tBYTEVECTOR: - val = pic_obj_value(pic_blob_new(pic, yylval.buf.dat, yylval.buf.len)); - pic_free(pic, yylval.buf.dat); - return val; - - case tLPAREN: - case tLBRACKET: - return read_pair(tok, scanner); - - case tVPAREN: - return pic_obj_value(read_vect(scanner)); - - case tQUOTE: - return read_abbrev(pic->sQUOTE, scanner); - - case tQUASIQUOTE: - return read_abbrev(pic->sQUASIQUOTE, scanner); - - case tUNQUOTE: - return read_abbrev(pic->sUNQUOTE, scanner); - - case tUNQUOTE_SPLICING: - return read_abbrev(pic->sUNQUOTE_SPLICING, scanner); - - case tRPAREN: - error("unexpected close parenthesis", scanner); - - case tRBRACKET: - error("unexpected close bracket", scanner); - - case tDOT: - error("unexpected '.'", scanner); - - case tEOF: - error(NULL, scanner); + if (c == EOF) { + read_error(pic, "unexpected EOF"); } - UNREACHABLE(); + switch (c) { + case ';': + return read_comment(pic, port, c); + case '#': + return read_dispatch(pic, port, c); + case '\'': + return read_quote(pic, port, c); + case '`': + return read_quasiquote(pic, port, c); + case ',': + return read_comma(pic, port, c); + case '"': + return read_string(pic, port, c); + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + return read_number(pic, port, c); + case '+': + return read_plus(pic, port, c); + case '-': + return read_minus(pic, port, c); + case '(': case '[': + return read_pair(pic, port, c); + default: + return read_symbol(pic, port, c); + } } static pic_value -read(int tok, yyscan_t scanner) +read(pic_state *pic, struct pic_port *port, char c) { - size_t ai = pic_gc_arena_preserve(pic); pic_value val; - val = read_datum(tok, scanner); + retry: + val = read_nullable(pic, port, c); + + if (pic_undef_p(val)) { + c = next(port); + goto retry; + } - pic_gc_arena_restore(pic, ai); - pic_gc_protect(pic, val); return val; } pic_value -read_one(yyscan_t scanner) +pic_read(pic_state *pic, struct pic_port *port) { - int tok; + pic_value val; + char c = next(port); - if (setjmp(yyjmp) != 0) { - pic_errorf(pic, "%s", yymsg ? yymsg : "unexpected EOF"); + retry: + c = skip(port, c); + + if (c == EOF) { + return pic_eof_object(); } - if ((tok = gettok(scanner)) == tEOF) { + val = read_nullable(pic, port, c); + + if (pic_undef_p(val)) { + c = next(port); + goto retry; + } + + return val; +} + +pic_value +pic_read_cstr(pic_state *pic, const char *str) +{ + struct pic_port *port; + + port = pic_open_input_string(pic, str); + + return pic_read(pic, port); +} + +static pic_value +pic_parse(pic_state *pic, struct pic_port *port) +{ + pic_value val, acc; + + pic_try { + acc = pic_nil_value(); + while (! pic_eof_p(val = pic_read(pic, port))) { + pic_push(pic, val, acc); + } + } + pic_catch { return pic_undef_value(); } - return read(tok, scanner); -} -pic_list -read_many(yyscan_t scanner) -{ - int tok; - pic_value vals; - - if (setjmp(yyjmp) != 0) { - if (yymsg) { - pic_errorf(pic, "%s", yymsg); - } - return pic_undef_value(); /* incomplete string */ - } - - vals = pic_nil_value(); - while ((tok = gettok(scanner)) != tEOF) { - vals = pic_cons(pic, read(tok, scanner), vals); - } - return pic_reverse(pic, vals); -} - -#undef pic - -pic_value -pic_read(pic_state *pic, const char *cstr) -{ - yyscan_t scanner; - struct parser_control ctrl; - pic_value val; - - ctrl.pic = pic; - xh_init_int(&ctrl.labels, sizeof(pic_value)); - yylex_init_extra(&ctrl, &scanner); - yy_scan_string(cstr, scanner); - - val = read_one(scanner); - - yylex_destroy(scanner); - xh_destroy(&ctrl.labels); - - return val; + return pic_reverse(pic, acc); } pic_list pic_parse_file(pic_state *pic, FILE *file) { - yyscan_t scanner; - struct parser_control ctrl; - pic_value vals; + struct pic_port *port; - ctrl.pic = pic; - xh_init_int(&ctrl.labels, sizeof(pic_value)); - yylex_init_extra(&ctrl, &scanner); - yyset_in(file, scanner); + port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT); + port->file = xfpopen(file); + port->flags = PIC_PORT_OUT | PIC_PORT_TEXT; + port->status = PIC_PORT_OPEN; - vals = read_many(scanner); - - yylex_destroy(scanner); - xh_destroy(&ctrl.labels); - - return vals; + return pic_parse(pic, port); } pic_list -pic_parse_cstr(pic_state *pic, const char *cstr) +pic_parse_cstr(pic_state *pic, const char *str) { - yyscan_t scanner; - struct parser_control ctrl; - pic_value vals; + struct pic_port *port; - ctrl.pic = pic; - xh_init_int(&ctrl.labels, sizeof(pic_value)); - yylex_init_extra(&ctrl, &scanner); - yy_scan_string(cstr, scanner); + port = pic_open_input_string(pic, str); - vals = read_many(scanner); - - yylex_destroy(scanner); - xh_destroy(&ctrl.labels); - - return vals; + return pic_parse(pic, port); } diff --git a/src/scan.l b/src/scan.l deleted file mode 100644 index 747f31a7..00000000 --- a/src/scan.l +++ /dev/null @@ -1,230 +0,0 @@ -/** - * See Copyright Notice in picrin.h - */ - -%{ -#include "picrin.h" -#include "picrin/parse.h" - -#define yylval (yyextra->yylval) - -#define YY_NO_UNISTD_H - -/* NOTE: - * An internal function `yy_fatal_error` takes yyscanner for its second - * argument but doesn't use it. This invokes a `unused variable` compiler - * warning and it became super unusable if `-Werror` is turned on the system. - * Since there's no flag to switch `yy_fatal_error` off and replace it with - * a user-defined function, we modify this macro constant to use yyscanner - * at least once avoiding get flex affected in any condition. - */ -#define YY_EXIT_FAILURE ( (void)yyscanner, 2 ) -%} - -%option reentrant - -%option noyyalloc -%option noyyrealloc -%option noyyfree -%option noinput -%option nounput -%option noyywrap - -%option extra-type="struct parser_control *" -%option never-interactive - - /* shebang */ -shebang #!.*$ - - /* comment */ -comment ;.*$ - - /* boolean */ -boolean #t|#f|#true|#false - - /* symbol */ -identifier [a-z0-9A-Z+/*!$%&:@^~?<=>_.-]+ - - /* number */ -digit [0-9] -real {sign}{ureal}|{infnan} -ureal {uinteger}|\.{digit}+|{digit}+\.{digit}* -integer {sign}{uinteger} -uinteger {digit}+ -sign [+-]? -infnan "+inf.0"|"-inf.0"|"+nan.0"|"-nan.0" - - /* char */ -%x CHAR - - /* string */ -%x STRING - - /* bytevector */ -%x BYTEVECTOR - - /* block comment */ -%x BLOCK_COMMENT - - /* datum label */ -label #{uinteger} -%x DATUM_LABEL - -%% - -[ \t\n\r] /* skip whitespace */ -{comment} /* skip comment */ -{shebang} /* skip shebang */ - -"#|" { - BEGIN(BLOCK_COMMENT); - yylval.i = 0; -} -"#|" { - yylval.i++; -} -"|#" { - if (yylval.i == 0) - BEGIN(INITIAL); - else - yylval.i--; -} -.|\n { - /* skip block comment */ -} - -{label} { - BEGIN(DATUM_LABEL); - yylval.i = atoi(yytext + 1); -} -= { - BEGIN(INITIAL); - return tLABEL_SET; -} -# { - BEGIN(INITIAL); - return tLABEL_REF; -} - -"#;" return tDATUM_COMMENT; -"." return tDOT; -"(" return tLPAREN; -")" return tRPAREN; -"[" return tLBRACKET; -"]" return tRBRACKET; -"#(" return tVPAREN; -"'" return tQUOTE; -"`" return tQUASIQUOTE; -"," return tUNQUOTE; -",@" return tUNQUOTE_SPLICING; - -{boolean} { - yylval.i = (yytext[1] == 't'); - return tBOOLEAN; -} - -{integer} { - yylval.i = atoi(yytext); - return tINT; -} - -{real} { - yylval.f = atof(yytext); - return tFLOAT; -} - -{identifier} { - yylval.buf.dat = yytext; - yylval.buf.len = yyleng; - return tSYMBOL; -} - -"\"" { - BEGIN(STRING); - yylval.buf.len = 0; - yylval.buf.dat = yyalloc(yylval.buf.len + 1, yyscanner); - strcpy(yylval.buf.dat, ""); -} -[^\\"]+ { - yylval.buf.len += yyleng; - yylval.buf.dat = yyrealloc(yylval.buf.dat, yylval.buf.len + 1, yyscanner); - strcpy(yylval.buf.dat + yylval.buf.len - yyleng, yytext); -} -\\. { - yylval.buf.len += 1; - yylval.buf.dat = yyrealloc(yylval.buf.dat, yylval.buf.len + 1, yyscanner); - yylval.buf.dat[yylval.buf.len] = '\0'; - - switch (yytext[yyleng - 1]) { - case 'a': yylval.buf.dat[yylval.buf.len - 1] = '\a'; break; - case 'b': yylval.buf.dat[yylval.buf.len - 1] = '\b'; break; - case 't': yylval.buf.dat[yylval.buf.len - 1] = '\t'; break; - case 'n': yylval.buf.dat[yylval.buf.len - 1] = '\n'; break; - case 'r': yylval.buf.dat[yylval.buf.len - 1] = '\r'; break; - default: yylval.buf.dat[yylval.buf.len - 1] = yytext[yyleng - 1]; break; - } -} -\\[:blank:]*\n[:blank:]* { - /* skip intraline whitespaces */ -} -\" { - BEGIN(INITIAL); - return tSTRING; -} - -#\\ { - BEGIN(CHAR); -} -alarm { yylval.c = '\a'; BEGIN(INITIAL); return tCHAR; } -backspace { yylval.c = '\b'; BEGIN(INITIAL); return tCHAR; } -delete { yylval.c = 0x7f; BEGIN(INITIAL); return tCHAR; } -escape { yylval.c = 0x1b; BEGIN(INITIAL); return tCHAR; } -newline { yylval.c = '\n'; BEGIN(INITIAL); return tCHAR; } -null { yylval.c = '\0'; BEGIN(INITIAL); return tCHAR; } -return { yylval.c = '\r'; BEGIN(INITIAL); return tCHAR; } -space { yylval.c = ' '; BEGIN(INITIAL); return tCHAR; } -tab { yylval.c = '\t'; BEGIN(INITIAL); return tCHAR; } -. { yylval.c = yytext[0]; BEGIN(INITIAL); return tCHAR; } - -"#u8(" { - BEGIN(BYTEVECTOR); - yylval.buf.len = 0; - yylval.buf.dat = NULL; -} -[ \r\n\t] { - /* skip whitespace */ -} -{uinteger} { - int i = atoi(yytext); - if (0 > i || i > 255) { - yyfree(yylval.buf.dat, yyscanner); - REJECT; - } - yylval.buf.len += 1; - yylval.buf.dat = yyrealloc(yylval.buf.dat, yylval.buf.len, yyscanner); - yylval.buf.dat[yylval.buf.len - 1] = (char)i; -} -")" { - BEGIN(INITIAL); - return tBYTEVECTOR; -} - -%% - -void * -yyalloc(size_t bytes, yyscan_t yyscanner) -{ - return pic_alloc(yyget_extra(yyscanner)->pic, bytes); -} - -void * -yyrealloc(void *ptr, size_t bytes, yyscan_t yyscanner) -{ - return pic_realloc(yyget_extra(yyscanner)->pic, ptr, bytes); -} - -void -yyfree(void * ptr, yyscan_t yyscanner) -{ - return pic_free(yyget_extra(yyscanner)->pic, ptr); -} diff --git a/src/state.c b/src/state.c index a9a13ba8..63a25254 100644 --- a/src/state.c +++ b/src/state.c @@ -64,6 +64,9 @@ pic_open(int argc, char *argv[], char **envp) pic->lib_tbl = pic_nil_value(); pic->lib = NULL; + /* reader */ + xh_init_int(&pic->rlabels, sizeof(pic_value)); + /* error handling */ pic->jmp = NULL; pic->err = NULL; @@ -116,8 +119,8 @@ pic_open(int argc, char *argv[], char **envp) pic_init_core(pic); /* set library */ - pic_make_library(pic, pic_read(pic, "(picrin user)")); - pic_in_library(pic, pic_read(pic, "(picrin user)")); + pic_make_library(pic, pic_read_cstr(pic, "(picrin user)")); + pic_in_library(pic, pic_read_cstr(pic, "(picrin user)")); return pic; } @@ -154,6 +157,7 @@ pic_close(pic_state *pic) xh_destroy(&pic->syms); xh_destroy(&pic->global_tbl); xh_destroy(&pic->macros); + xh_destroy(&pic->rlabels); /* free GC arena */ free(pic->arena); diff --git a/src/write.c b/src/write.c index 952bf436..4aae7e44 100644 --- a/src/write.c +++ b/src/write.c @@ -440,8 +440,8 @@ pic_printf(pic_state *pic, const char *fmt, ...) va_end(ap); - printf("%s", pic_str_cstr(str)); - fflush(stdout); + xprintf("%s", pic_str_cstr(str)); + xfflush(xstdout); } static pic_value diff --git a/tools/main.c b/tools/main.c index 2d3a8cfd..83f7bd40 100644 --- a/tools/main.c +++ b/tools/main.c @@ -39,16 +39,16 @@ import_repllib(pic_state *pic) { int ai = pic_gc_arena_preserve(pic); - pic_import(pic, pic_read(pic, "(scheme base)")); - pic_import(pic, pic_read(pic, "(scheme load)")); - pic_import(pic, pic_read(pic, "(scheme process-context)")); - pic_import(pic, pic_read(pic, "(scheme write)")); - pic_import(pic, pic_read(pic, "(scheme file)")); - pic_import(pic, pic_read(pic, "(scheme inexact)")); - pic_import(pic, pic_read(pic, "(scheme cxr)")); - pic_import(pic, pic_read(pic, "(scheme lazy)")); - pic_import(pic, pic_read(pic, "(scheme time)")); - pic_import(pic, pic_read(pic, "(picrin macro)")); + pic_import(pic, pic_read_cstr(pic, "(scheme base)")); + pic_import(pic, pic_read_cstr(pic, "(scheme load)")); + pic_import(pic, pic_read_cstr(pic, "(scheme process-context)")); + pic_import(pic, pic_read_cstr(pic, "(scheme write)")); + pic_import(pic, pic_read_cstr(pic, "(scheme file)")); + pic_import(pic, pic_read_cstr(pic, "(scheme inexact)")); + pic_import(pic, pic_read_cstr(pic, "(scheme cxr)")); + pic_import(pic, pic_read_cstr(pic, "(scheme lazy)")); + pic_import(pic, pic_read_cstr(pic, "(scheme time)")); + pic_import(pic, pic_read_cstr(pic, "(picrin macro)")); #if DEBUG puts("* imported repl libraries"); @@ -289,7 +289,7 @@ main(int argc, char *argv[], char **envp) parse_opt(argc, argv); if (mode == INTERACTIVE_MODE || mode == ONE_LINER_MODE) { - import_repllib(pic); + // import_repllib(pic); } switch (mode) {