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;
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -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_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 *);
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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");
|
||||
|
|
|
|||
|
|
@ -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) {
|
||||
|
|
|
|||
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);
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
|
|
|||
727
src/read.c
727
src/read.c
|
|
@ -2,84 +2,428 @@
|
|||
* See Copyright Notice in picrin.h
|
||||
*/
|
||||
|
||||
#include <ctype.h>
|
||||
#include <math.h>
|
||||
#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);
|
||||
}
|
||||
|
|
|
|||
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 = 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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
22
tools/main.c
22
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) {
|
||||
|
|
|
|||
Loading…
Reference in New Issue