Merge branch 'abandon-flex'
This commit is contained in:
Yuichi Nishiwaki
commit
107a1dc339
|
|
@ -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 <string>])
|
|
||||||
# which creates a custom command to generate the <FlexOutput> file from
|
|
||||||
# the <FlexInput> 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 <FlexTarget> and <BisonTarget> 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(<Name> <Input> <Output> [COMPILE_FLAGS <string>]")
|
|
||||||
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
|
|
||||||
|
|
@ -1 +1 @@
|
||||||
Subproject commit c7d08eb1abc829f3380991d3754a1ef6ce539c4d
|
Subproject commit 45cad164afcd0ad3f83286f39ae947c0e595c077
|
||||||
|
|
@ -100,6 +100,8 @@ typedef struct {
|
||||||
pic_value lib_tbl;
|
pic_value lib_tbl;
|
||||||
struct pic_lib *lib;
|
struct pic_lib *lib;
|
||||||
|
|
||||||
|
xhash rlabels;
|
||||||
|
|
||||||
jmp_buf *jmp;
|
jmp_buf *jmp;
|
||||||
struct pic_error *err;
|
struct pic_error *err;
|
||||||
struct pic_jmpbuf *try_jmps;
|
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_strdup(pic_state *, const char *);
|
||||||
char *pic_strndup(pic_state *, const char *, size_t);
|
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_file(pic_state *, FILE *); /* #f for incomplete input */
|
||||||
pic_list pic_parse_cstr(pic_state *, const char *);
|
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) \
|
#define pic_deflibrary_helper__(i, prev_lib, spec) \
|
||||||
for (int i = 0; ! i; ) \
|
for (int i = 0; ! i; ) \
|
||||||
for (struct pic_lib *prev_lib; ! 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_import(pic_state *, pic_value);
|
||||||
void pic_export(pic_state *, pic_sym);
|
void pic_export(pic_state *, pic_sym);
|
||||||
|
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -37,6 +37,7 @@ struct pic_port *pic_stdin(pic_state *);
|
||||||
struct pic_port *pic_stdout(pic_state *);
|
struct pic_port *pic_stdout(pic_state *);
|
||||||
struct pic_port *pic_stderr(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_port *pic_open_output_string(pic_state *);
|
||||||
struct pic_string *pic_get_output_string(pic_state *, struct pic_port *);
|
struct pic_string *pic_get_output_string(pic_state *, struct pic_port *);
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -158,6 +158,7 @@ typedef struct pic_blob pic_blob;
|
||||||
#define pic_int_p(v) (pic_vtype(v) == PIC_VTYPE_INT)
|
#define pic_int_p(v) (pic_vtype(v) == PIC_VTYPE_INT)
|
||||||
#define pic_sym_p(v) (pic_vtype(v) == PIC_VTYPE_SYMBOL)
|
#define pic_sym_p(v) (pic_vtype(v) == PIC_VTYPE_SYMBOL)
|
||||||
#define pic_char_p(v) (pic_vtype(v) == PIC_VTYPE_CHAR)
|
#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))
|
#define pic_test(v) (! pic_false_p(v))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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
|
# xfile
|
||||||
set(XFILE_SOURCES extlib/xfile/xfile.c)
|
set(XFILE_SOURCES extlib/xfile/xfile.c)
|
||||||
|
|
||||||
|
|
@ -18,7 +13,7 @@ add_custom_command(
|
||||||
|
|
||||||
# build!
|
# build!
|
||||||
file(GLOB PICRIN_SOURCES ${PROJECT_SOURCE_DIR}/src/*.c)
|
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})
|
target_link_libraries(picrin m ${PICRIN_CONTRIB_LIBRARIES})
|
||||||
|
|
||||||
# install
|
# install
|
||||||
|
|
|
||||||
|
|
@ -68,7 +68,7 @@ new_analyze_state(pic_state *pic)
|
||||||
state->pic = pic;
|
state->pic = pic;
|
||||||
state->scope = NULL;
|
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 */
|
/* native VM procedures */
|
||||||
register_renamed_symbol(pic, state, rCONS, stdlib, "cons");
|
register_renamed_symbol(pic, state, rCONS, stdlib, "cons");
|
||||||
|
|
|
||||||
|
|
@ -14,7 +14,7 @@ pic_load_cstr(pic_state *pic, const char *src)
|
||||||
|
|
||||||
exprs = pic_parse_cstr(pic, src);
|
exprs = pic_parse_cstr(pic, src);
|
||||||
if (pic_undef_p(exprs)) {
|
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) {
|
pic_for_each (v, exprs) {
|
||||||
|
|
@ -48,7 +48,7 @@ pic_load(pic_state *pic, const char *fn)
|
||||||
|
|
||||||
exprs = pic_parse_file(pic, file);
|
exprs = pic_parse_file(pic, file);
|
||||||
if (pic_undef_p(exprs)) {
|
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) {
|
pic_for_each (v, exprs) {
|
||||||
|
|
|
||||||
37
src/port.c
37
src/port.c
|
|
@ -54,6 +54,23 @@ port_new_stdport(pic_state *pic, xFILE *file, short dir)
|
||||||
return pic_obj_value(port);
|
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 *
|
struct pic_port *
|
||||||
pic_open_output_string(pic_state *pic)
|
pic_open_output_string(pic_state *pic)
|
||||||
{
|
{
|
||||||
|
|
@ -70,19 +87,20 @@ pic_open_output_string(pic_state *pic)
|
||||||
struct pic_string *
|
struct pic_string *
|
||||||
pic_get_output_string(pic_state *pic, struct pic_port *port)
|
pic_get_output_string(pic_state *pic, struct pic_port *port)
|
||||||
{
|
{
|
||||||
long endpos;
|
long size;
|
||||||
char *buf;
|
char *buf;
|
||||||
|
|
||||||
/* get endpos */
|
/* get endpos */
|
||||||
xfflush(port->file);
|
xfflush(port->file);
|
||||||
endpos = xftell(port->file);
|
size = xftell(port->file);
|
||||||
xrewind(port->file);
|
xrewind(port->file);
|
||||||
|
|
||||||
/* copy to buf */
|
/* copy to buf */
|
||||||
buf = (char *)pic_alloc(pic, endpos);
|
buf = (char *)pic_alloc(pic, size + 1);
|
||||||
xfread(buf, 1, endpos, port->file);
|
buf[size] = 0;
|
||||||
|
xfread(buf, size, 1, port->file);
|
||||||
|
|
||||||
return pic_str_new(pic, buf, endpos);
|
return pic_str_new(pic, buf, size);
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
|
|
@ -268,14 +286,7 @@ pic_port_open_input_string(pic_state *pic)
|
||||||
|
|
||||||
pic_get_args(pic, "z", &str);
|
pic_get_args(pic, "z", &str);
|
||||||
|
|
||||||
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT);
|
port = pic_open_input_string(pic, str);
|
||||||
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 pic_obj_value(port);
|
return pic_obj_value(port);
|
||||||
}
|
}
|
||||||
|
|
|
||||||
717
src/read.c
717
src/read.c
|
|
@ -2,84 +2,428 @@
|
||||||
* See Copyright Notice in picrin.h
|
* See Copyright Notice in picrin.h
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
#include <ctype.h>
|
||||||
|
#include <math.h>
|
||||||
#include "picrin.h"
|
#include "picrin.h"
|
||||||
#include "picrin/parse.h"
|
#include "picrin/error.h"
|
||||||
#include "picrin/pair.h"
|
#include "picrin/pair.h"
|
||||||
#include "picrin/string.h"
|
#include "picrin/string.h"
|
||||||
#include "picrin/vector.h"
|
#include "picrin/vector.h"
|
||||||
#include "picrin/blob.h"
|
#include "picrin/blob.h"
|
||||||
#include "picrin/port.h"
|
#include "picrin/port.h"
|
||||||
|
|
||||||
#define YY_NO_UNISTD_H
|
typedef pic_value (*read_func_t)(pic_state *, struct pic_port *, char);
|
||||||
#include "lex.yy.h"
|
|
||||||
|
|
||||||
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)
|
static noreturn void
|
||||||
#define yylval (yyget_extra(scanner)->yylval)
|
read_error(pic_state *pic, const char *msg)
|
||||||
#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)
|
|
||||||
{
|
{
|
||||||
yymsg = msg;
|
pic_error(pic, msg);
|
||||||
longjmp(yyjmp, 1);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int
|
static char
|
||||||
gettok(yyscan_t scanner)
|
skip(struct pic_port *port, char c)
|
||||||
{
|
{
|
||||||
int tok;
|
while (isspace(c)) {
|
||||||
|
c = xfgetc(port->file);
|
||||||
while ((tok = yylex(scanner)) == tDATUM_COMMENT) {
|
|
||||||
read(gettok(scanner), scanner); /* discard */
|
|
||||||
}
|
}
|
||||||
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
|
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;
|
pic_value val;
|
||||||
|
|
||||||
switch (tok = gettok(scanner)) {
|
c = next(port);
|
||||||
case tLPAREN:
|
|
||||||
case tLBRACKET:
|
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;
|
pic_value tmp;
|
||||||
|
|
||||||
val = pic_cons(pic, pic_none_value(), pic_none_value());
|
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)->car = pic_car(pic, tmp);
|
||||||
pic_pair_ptr(val)->cdr = pic_cdr(pic, tmp);
|
pic_pair_ptr(val)->cdr = pic_cdr(pic, tmp);
|
||||||
|
|
||||||
return val;
|
return val;
|
||||||
}
|
}
|
||||||
case tVPAREN:
|
case '#':
|
||||||
{
|
{
|
||||||
|
bool vect;
|
||||||
|
|
||||||
|
if (peek(port) == '(') {
|
||||||
|
vect = true;
|
||||||
|
} else {
|
||||||
|
vect = false;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (vect) {
|
||||||
pic_vec *tmp;
|
pic_vec *tmp;
|
||||||
|
|
||||||
val = pic_obj_value(pic_vec_new(pic, 0));
|
val = pic_obj_value(pic_vec_new(pic, 0));
|
||||||
|
|
||||||
xh_put_int(&yylabels, i, &val);
|
xh_put_int(&pic->rlabels, i, &val);
|
||||||
|
|
||||||
tmp = pic_vec_ptr(read(tok, scanner));
|
tmp = pic_vec_ptr(read(pic, port, c));
|
||||||
SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data);
|
SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data);
|
||||||
SWAP(size_t, tmp->len, pic_vec_ptr(val)->len);
|
SWAP(size_t, tmp->len, pic_vec_ptr(val)->len);
|
||||||
|
|
||||||
return val;
|
return val;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
FALLTHROUGH;
|
||||||
|
}
|
||||||
default:
|
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;
|
return val;
|
||||||
}
|
}
|
||||||
|
|
@ -87,239 +431,188 @@ read_label_set(int i, yyscan_t scanner)
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
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;
|
xh_entry *e;
|
||||||
|
|
||||||
e = xh_get_int(&yylabels, i);
|
UNUSED(port);
|
||||||
|
|
||||||
|
e = xh_get_int(&pic->rlabels, i);
|
||||||
if (! e) {
|
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);
|
return xh_val(e, pic_value);
|
||||||
}
|
}
|
||||||
|
|
||||||
static 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;
|
int i;
|
||||||
pic_value car, cdr;
|
|
||||||
|
|
||||||
tok = gettok(scanner);
|
i = 0;
|
||||||
if (tok == tCLOSE) {
|
do {
|
||||||
return pic_nil_value();
|
i = i * 10 + c;
|
||||||
}
|
} while (isdigit(c = next(port)));
|
||||||
if (tok == tDOT) {
|
|
||||||
cdr = read(gettok(scanner), scanner);
|
|
||||||
|
|
||||||
if (gettok(scanner) != tCLOSE) {
|
if (c == '=') {
|
||||||
error("unmatched parenthesis", scanner);
|
return read_label_set(pic, port, i);
|
||||||
}
|
}
|
||||||
return cdr;
|
if (c == '#') {
|
||||||
|
return read_label_ref(pic, port, i);
|
||||||
}
|
}
|
||||||
else {
|
read_error(pic, "broken label expression");
|
||||||
car = read(tok, scanner);
|
|
||||||
cdr = read_pair(tOPEN, scanner);
|
|
||||||
return pic_cons(pic, car, cdr);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
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));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
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
|
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) {
|
if (c == EOF) {
|
||||||
case tLABEL_SET:
|
read_error(pic, "unexpected EOF");
|
||||||
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);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
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
|
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;
|
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;
|
return val;
|
||||||
}
|
}
|
||||||
|
|
||||||
pic_value
|
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) {
|
retry:
|
||||||
pic_errorf(pic, "%s", yymsg ? yymsg : "unexpected EOF");
|
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 pic_undef_value();
|
||||||
}
|
}
|
||||||
return read(tok, scanner);
|
|
||||||
}
|
|
||||||
|
|
||||||
pic_list
|
return pic_reverse(pic, acc);
|
||||||
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;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
pic_list
|
pic_list
|
||||||
pic_parse_file(pic_state *pic, FILE *file)
|
pic_parse_file(pic_state *pic, FILE *file)
|
||||||
{
|
{
|
||||||
yyscan_t scanner;
|
struct pic_port *port;
|
||||||
struct parser_control ctrl;
|
|
||||||
pic_value vals;
|
|
||||||
|
|
||||||
ctrl.pic = pic;
|
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT);
|
||||||
xh_init_int(&ctrl.labels, sizeof(pic_value));
|
port->file = xfpopen(file);
|
||||||
yylex_init_extra(&ctrl, &scanner);
|
port->flags = PIC_PORT_OUT | PIC_PORT_TEXT;
|
||||||
yyset_in(file, scanner);
|
port->status = PIC_PORT_OPEN;
|
||||||
|
|
||||||
vals = read_many(scanner);
|
return pic_parse(pic, port);
|
||||||
|
|
||||||
yylex_destroy(scanner);
|
|
||||||
xh_destroy(&ctrl.labels);
|
|
||||||
|
|
||||||
return vals;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
pic_list
|
pic_list
|
||||||
pic_parse_cstr(pic_state *pic, const char *cstr)
|
pic_parse_cstr(pic_state *pic, const char *str)
|
||||||
{
|
{
|
||||||
yyscan_t scanner;
|
struct pic_port *port;
|
||||||
struct parser_control ctrl;
|
|
||||||
pic_value vals;
|
|
||||||
|
|
||||||
ctrl.pic = pic;
|
port = pic_open_input_string(pic, str);
|
||||||
xh_init_int(&ctrl.labels, sizeof(pic_value));
|
|
||||||
yylex_init_extra(&ctrl, &scanner);
|
|
||||||
yy_scan_string(cstr, scanner);
|
|
||||||
|
|
||||||
vals = read_many(scanner);
|
return pic_parse(pic, port);
|
||||||
|
|
||||||
yylex_destroy(scanner);
|
|
||||||
xh_destroy(&ctrl.labels);
|
|
||||||
|
|
||||||
return vals;
|
|
||||||
}
|
}
|
||||||
|
|
|
||||||
230
src/scan.l
230
src/scan.l
|
|
@ -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;
|
|
||||||
}
|
|
||||||
<BLOCK_COMMENT>"#|" {
|
|
||||||
yylval.i++;
|
|
||||||
}
|
|
||||||
<BLOCK_COMMENT>"|#" {
|
|
||||||
if (yylval.i == 0)
|
|
||||||
BEGIN(INITIAL);
|
|
||||||
else
|
|
||||||
yylval.i--;
|
|
||||||
}
|
|
||||||
<BLOCK_COMMENT>.|\n {
|
|
||||||
/* skip block comment */
|
|
||||||
}
|
|
||||||
|
|
||||||
{label} {
|
|
||||||
BEGIN(DATUM_LABEL);
|
|
||||||
yylval.i = atoi(yytext + 1);
|
|
||||||
}
|
|
||||||
<DATUM_LABEL>= {
|
|
||||||
BEGIN(INITIAL);
|
|
||||||
return tLABEL_SET;
|
|
||||||
}
|
|
||||||
<DATUM_LABEL># {
|
|
||||||
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, "");
|
|
||||||
}
|
|
||||||
<STRING>[^\\"]+ {
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
<STRING>\\. {
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
<STRING>\\[:blank:]*\n[:blank:]* {
|
|
||||||
/* skip intraline whitespaces */
|
|
||||||
}
|
|
||||||
<STRING>\" {
|
|
||||||
BEGIN(INITIAL);
|
|
||||||
return tSTRING;
|
|
||||||
}
|
|
||||||
|
|
||||||
#\\ {
|
|
||||||
BEGIN(CHAR);
|
|
||||||
}
|
|
||||||
<CHAR>alarm { yylval.c = '\a'; BEGIN(INITIAL); return tCHAR; }
|
|
||||||
<CHAR>backspace { yylval.c = '\b'; BEGIN(INITIAL); return tCHAR; }
|
|
||||||
<CHAR>delete { yylval.c = 0x7f; BEGIN(INITIAL); return tCHAR; }
|
|
||||||
<CHAR>escape { yylval.c = 0x1b; BEGIN(INITIAL); return tCHAR; }
|
|
||||||
<CHAR>newline { yylval.c = '\n'; BEGIN(INITIAL); return tCHAR; }
|
|
||||||
<CHAR>null { yylval.c = '\0'; BEGIN(INITIAL); return tCHAR; }
|
|
||||||
<CHAR>return { yylval.c = '\r'; BEGIN(INITIAL); return tCHAR; }
|
|
||||||
<CHAR>space { yylval.c = ' '; BEGIN(INITIAL); return tCHAR; }
|
|
||||||
<CHAR>tab { yylval.c = '\t'; BEGIN(INITIAL); return tCHAR; }
|
|
||||||
<CHAR>. { yylval.c = yytext[0]; BEGIN(INITIAL); return tCHAR; }
|
|
||||||
|
|
||||||
"#u8(" {
|
|
||||||
BEGIN(BYTEVECTOR);
|
|
||||||
yylval.buf.len = 0;
|
|
||||||
yylval.buf.dat = NULL;
|
|
||||||
}
|
|
||||||
<BYTEVECTOR>[ \r\n\t] {
|
|
||||||
/* skip whitespace */
|
|
||||||
}
|
|
||||||
<BYTEVECTOR>{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;
|
|
||||||
}
|
|
||||||
<BYTEVECTOR>")" {
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
|
|
@ -64,6 +64,9 @@ pic_open(int argc, char *argv[], char **envp)
|
||||||
pic->lib_tbl = pic_nil_value();
|
pic->lib_tbl = pic_nil_value();
|
||||||
pic->lib = NULL;
|
pic->lib = NULL;
|
||||||
|
|
||||||
|
/* reader */
|
||||||
|
xh_init_int(&pic->rlabels, sizeof(pic_value));
|
||||||
|
|
||||||
/* error handling */
|
/* error handling */
|
||||||
pic->jmp = NULL;
|
pic->jmp = NULL;
|
||||||
pic->err = NULL;
|
pic->err = NULL;
|
||||||
|
|
@ -116,8 +119,8 @@ pic_open(int argc, char *argv[], char **envp)
|
||||||
pic_init_core(pic);
|
pic_init_core(pic);
|
||||||
|
|
||||||
/* set library */
|
/* set library */
|
||||||
pic_make_library(pic, pic_read(pic, "(picrin user)"));
|
pic_make_library(pic, pic_read_cstr(pic, "(picrin user)"));
|
||||||
pic_in_library(pic, pic_read(pic, "(picrin user)"));
|
pic_in_library(pic, pic_read_cstr(pic, "(picrin user)"));
|
||||||
|
|
||||||
return pic;
|
return pic;
|
||||||
}
|
}
|
||||||
|
|
@ -154,6 +157,7 @@ pic_close(pic_state *pic)
|
||||||
xh_destroy(&pic->syms);
|
xh_destroy(&pic->syms);
|
||||||
xh_destroy(&pic->global_tbl);
|
xh_destroy(&pic->global_tbl);
|
||||||
xh_destroy(&pic->macros);
|
xh_destroy(&pic->macros);
|
||||||
|
xh_destroy(&pic->rlabels);
|
||||||
|
|
||||||
/* free GC arena */
|
/* free GC arena */
|
||||||
free(pic->arena);
|
free(pic->arena);
|
||||||
|
|
|
||||||
|
|
@ -440,8 +440,8 @@ pic_printf(pic_state *pic, const char *fmt, ...)
|
||||||
|
|
||||||
va_end(ap);
|
va_end(ap);
|
||||||
|
|
||||||
printf("%s", pic_str_cstr(str));
|
xprintf("%s", pic_str_cstr(str));
|
||||||
fflush(stdout);
|
xfflush(xstdout);
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
|
|
|
||||||
22
tools/main.c
22
tools/main.c
|
|
@ -39,16 +39,16 @@ import_repllib(pic_state *pic)
|
||||||
{
|
{
|
||||||
int ai = pic_gc_arena_preserve(pic);
|
int ai = pic_gc_arena_preserve(pic);
|
||||||
|
|
||||||
pic_import(pic, pic_read(pic, "(scheme base)"));
|
pic_import(pic, pic_read_cstr(pic, "(scheme base)"));
|
||||||
pic_import(pic, pic_read(pic, "(scheme load)"));
|
pic_import(pic, pic_read_cstr(pic, "(scheme load)"));
|
||||||
pic_import(pic, pic_read(pic, "(scheme process-context)"));
|
pic_import(pic, pic_read_cstr(pic, "(scheme process-context)"));
|
||||||
pic_import(pic, pic_read(pic, "(scheme write)"));
|
pic_import(pic, pic_read_cstr(pic, "(scheme write)"));
|
||||||
pic_import(pic, pic_read(pic, "(scheme file)"));
|
pic_import(pic, pic_read_cstr(pic, "(scheme file)"));
|
||||||
pic_import(pic, pic_read(pic, "(scheme inexact)"));
|
pic_import(pic, pic_read_cstr(pic, "(scheme inexact)"));
|
||||||
pic_import(pic, pic_read(pic, "(scheme cxr)"));
|
pic_import(pic, pic_read_cstr(pic, "(scheme cxr)"));
|
||||||
pic_import(pic, pic_read(pic, "(scheme lazy)"));
|
pic_import(pic, pic_read_cstr(pic, "(scheme lazy)"));
|
||||||
pic_import(pic, pic_read(pic, "(scheme time)"));
|
pic_import(pic, pic_read_cstr(pic, "(scheme time)"));
|
||||||
pic_import(pic, pic_read(pic, "(picrin macro)"));
|
pic_import(pic, pic_read_cstr(pic, "(picrin macro)"));
|
||||||
|
|
||||||
#if DEBUG
|
#if DEBUG
|
||||||
puts("* imported repl libraries");
|
puts("* imported repl libraries");
|
||||||
|
|
@ -289,7 +289,7 @@ main(int argc, char *argv[], char **envp)
|
||||||
parse_opt(argc, argv);
|
parse_opt(argc, argv);
|
||||||
|
|
||||||
if (mode == INTERACTIVE_MODE || mode == ONE_LINER_MODE) {
|
if (mode == INTERACTIVE_MODE || mode == ONE_LINER_MODE) {
|
||||||
import_repllib(pic);
|
// import_repllib(pic);
|
||||||
}
|
}
|
||||||
|
|
||||||
switch (mode) {
|
switch (mode) {
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue