conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' into equal

This commit is contained in:
Sunrim KIM (keen) 2014-06-18 00:48:41 +09:00
parent d706240ada 0ca09f355e
commit a0b77fc328
32 changed files with 957 additions and 230 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
AUTHORS
View File

@ -4,3 +4,4 @@ Yuito Murase (themamedaifuku@gmail.com)
Hiromu Yakura (hiromu1996@gmail.com)
Wataru Nakanishi (stibear1996@gmail.com)
Hiroki Kobayashi (silentkiddie-2013@yahoo.co.jp)
Sunrim Kim (3han5chou7@gmail.com)

12
CMakeLists.txt
View File

@ -1,4 +1,4 @@
cmake_minimum_required(VERSION 2.8)
cmake_minimum_required(VERSION 2.6)
PROJECT(picrin)
@ -16,8 +16,16 @@ execute_process(
set(CMAKE_RUNTIME_OUTPUT_DIRECTORY bin)
set(CMAKE_LIBRARY_OUTPUT_DIRECTORY lib)
set(CMAKE_C_FLAGS "-Wall -Wextra -std=c99")
set(CMAKE_C_FLAGS "-Wall -Wextra")
set(CMAKE_C_FLAGS_DEBUG "-g -DDEBUG=1")
option(USE_C11_FEATURE "Enable c11 feature" OFF)
if(USE_C11_FEATURE)
add_definitions(-std=c11)
else()
add_definitions(-std=c99) # at least c99 is required
endif()
include_directories(include extlib)
# build picrin

47
README.md
View File

@ -4,7 +4,7 @@ Picrin is a lightweight scheme implementation intended to comply with full R7RS
## Features
- R7RS compatibility (but partial support)
- R7RS compatibility
- reentrant design (all VM states are stored in single global state object)
- bytecode interpreter (based on stack VM)
- direct threaded VM
@ -29,44 +29,51 @@ https://github.com/wasabiz/picrin
## IRC
There is a chat room on chat.freenode.org, channel #picrin.
There is a chat room on chat.freenode.org, channel #picrin. IRC logs here: https://botbot.me/freenode/picrin/
## How to use it
- make `Makefile`
To build picrin, you need some build tools installed on your platform.
Change directory to `build` then run `cmake` to create Makefile. Once `Makefile` is generated you can run `make` command to build picrin.
- cmake (>= 2.6)
- git
$ cd build
$ cmake ..
Because of submodule dependencies, it is necessary to get picrin's source code via git clone command. Basically our git dependencies are only due to submodules, so in fact, If you have no git on your machine, it is possible to build it by downloading a tarball from github page as well. But in such case, you are assumed to modify CMakeLists.txt by yourself to get it work completely. We just strongly recommend you to use git-clone.
Actually you don't necessarily need to move to `build` directory before running `cmake` (in that case `$ cmake .`), but I strongly recommend to follow above instruction.
### Generate Makefile
Change directory to `build` then run `ccmake` to create Makefile. Once `Makefile` is generated you can run `make` command to build picrin.
$ cd build
$ ccmake ..
Actually you don't necessarily need to move to `build` directory before running `ccmake` (in that case `$ ccmake .`), but I strongly recommend to follow above instruction.
- build
### Build
A built executable binary will be under bin/ directory and shared libraries under lib/.
A built executable binary will be under bin/ directory and shared libraries under lib/.
$ make
$ make
If you are building picrin on other systems than x86_64, PIC_NAN_BOXING flag is automatically turned on (see include/picrin/config.h for detail).
If you are building picrin on other systems than x86_64, PIC_NAN_BOXING flag is automatically turned on (see include/picrin/config.h for detail).
- install
### Install
Just running `make install`, picrin library, headers, and runtime binary are install on your system, by default into `/usr/local` directory. You can change this value via ccmake.
Just running `make install`, picrin library, headers, and runtime binary are install on your system, by default into `/usr/local` directory. You can change this value via ccmake.
$ make install
$ make install
- run
### Run
Before installing picrin, you can try picrin without breaking any of your system. Simply directly run the binary `bin/picrin` from terminal, or you can use `make` to execute it like this.
Before installing picrin, you can try picrin without breaking any of your system. Simply directly run the binary `bin/picrin` from terminal, or you can use `make` to execute it like this.
$ make run
$ make run
- debug run
### Debug run
If you execute `cmake` with debug flag `-DCMAKE_BUILD_TYPE=Debug`, it builds the binary with all debug flags enabled (PIC_GC_STRESS, VM_DEBUG, DEBUG).
If you execute `cmake` with debug flag `-DCMAKE_BUILD_TYPE=Debug`, it builds the binary with all debug flags enabled (PIC_GC_STRESS, VM_DEBUG, DEBUG).
$ cmake -DCMAKE_BUILD_TYPE=Debug ..
$ cmake -DCMAKE_BUILD_TYPE=Debug ..
## Requirement

179
cmake/FindFLEX.cmake Normal file
View File

@ -0,0 +1,179 @@
# - 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

46
cmake/FindGit.cmake Normal file
View File

@ -0,0 +1,46 @@
# The module defines the following variables:
# GIT_EXECUTABLE - path to git command line client
# GIT_FOUND - true if the command line client was found
# Example usage:
# find_package(Git)
# if(GIT_FOUND)
# message("git found: ${GIT_EXECUTABLE}")
# endif()
#=============================================================================
# Copyright 2010 Kitware, Inc.
#
# Distributed under the OSI-approved BSD License (the "License");
# see accompanying file Copyright.txt for details.
#
# 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.
#=============================================================================
# (To distributed this file outside of CMake, substitute the full
# License text for the above reference.)
# Look for 'git' or 'eg' (easy git)
#
set(git_names git eg)
# Prefer .cmd variants on Windows unless running in a Makefile
# in the MSYS shell.
#
if(WIN32)
if(NOT CMAKE_GENERATOR MATCHES "MSYS")
set(git_names git.cmd git eg.cmd eg)
endif()
endif()
find_program(GIT_EXECUTABLE
NAMES ${git_names}
DOC "git command line client"
)
mark_as_advanced(GIT_EXECUTABLE)
# Handle the QUIETLY and REQUIRED arguments and set GIT_FOUND to TRUE if
# all listed variables are TRUE
include(FindPackageHandleStandardArgs)
find_package_handle_standard_args(Git DEFAULT_MSG GIT_EXECUTABLE)

71
docs/deploy.rst Normal file
View File

@ -0,0 +1,71 @@
Installation
============
Installation instructions below.
Build and Install
-----------------
To build picrin, you need some build tools installed on your platform.
- cmake (>= 2.6)
- git
Because of submodule dependencies, it is necessary to get picrin's source code via git clone command. Basically our git dependencies are only due to submodules, so in fact, If you have no git on your machine, it is possible to build it by downloading a tarball from github page as well. But in such case, you are assumed to modify CMakeLists.txt by yourself to get it work completely. We just strongly recommend you to use git-clone.
Generate Makefile
^^^^^^^^^^^^^^^^^
Change directory to `build` then run `ccmake` to create Makefile. Once `Makefile` is generated you can run `make` command to build picrin::
$ cd build
$ ccmake ..
Actually you don't necessarily need to move to `build` directory before running `ccmake` (in that case `$ ccmake .`), but I strongly recommend to follow above instruction.
Build
^^^^^
A built executable binary will be under bin/ directory and shared libraries under lib/::
$ make
If you are building picrin on other systems than x86_64, PIC_NAN_BOXING flag is automatically turned on (see include/picrin/config.h for detail).
Install
^^^^^^^
Just running `make install`, picrin library, headers, and runtime binary are install on your system, by default into `/usr/local` directory. You can change this value via ccmake::
$ make install
Run
^^^
Before installing picrin, you can try picrin without breaking any of your system. Simply directly run the binary `bin/picrin` from terminal, or you can use `make` to execute it like this::
$ make run
Debug run
^^^^^^^^^
If you execute `cmake` with debug flag `-DCMAKE_BUILD_TYPE=Debug`, it builds the binary with all debug flags enabled (PIC_GC_STRESS, VM_DEBUG, DEBUG)::
$ cmake -DCMAKE_BUILD_TYPE=Debug ..
Requirement
-----------
Picrin scheme depends on some external libraries to build the binary:
- perl
- lex (preferably, flex)
- getopt
- readline (optional)
- regex.h of POSIX.1 (optional)
Optional libraries are, if cmake detected them, automatically enabled.
The compilation is tested only on Mac OSX and Ubuntu. I think (or hope) it'll be ok to compile and run on other operating systems such as Arch or Windows, but I don't guarantee :(

2
docs/index.rst
View File

@ -12,7 +12,9 @@ Contents:
:maxdepth: 2
intro.rst
deploy.rst
lang.rst
libs.rst
Indices and tables
==================

63
docs/intro.rst
View File

@ -3,7 +3,7 @@ Introduction
Picrin is a lightweight scheme implementation intended to comply with full R7RS specification. Its code is written in pure C99 and does not requires any special external libraries installed on the platform.
- R7RS compatibility (but partial support)
- R7RS compatibility
- reentrant design (all VM states are stored in single global state object)
- bytecode interpreter (based on stack VM)
- direct threaded VM
@ -16,60 +16,6 @@ Picrin is a lightweight scheme implementation intended to comply with full R7RS
- advanced REPL support (multi-line input, etc)
- tiny & portable library (all functions will be in `libpicrin.so`)
Installation
------------
- make `Makefile`
Change directory to `build` then run `cmake` to create Makefile. Once `Makefile` is generated you can run `make` command to build picrin::
$ cd build
$ cmake ..
Actually you don't necessarily need to move to `build` directory before running `cmake` (in that case `$ cmake .`), but I strongly recommend to follow above instruction.
- build
A built executable binary will be under bin/ directory and shared libraries under lib/::
$ make
If you are building picrin on other systems than x86_64, PIC_NAN_BOXING flag is automatically turned on (see include/picrin/config.h for detail).
- install
Just running `make install`, picrin library, headers, and runtime binary are install on your system, by default into `/usr/local` directory. You can change this value via ccmake::
$ make install
- run
Before installing picrin, you can try picrin without breaking any of your system. Simply directly run the binary `bin/picrin` from terminal, or you can use `make` to execute it like this::
$ make run
- debug run
If you execute `cmake` with debug flag `-DCMAKE_BUILD_TYPE=Debug`, it builds the binary with all debug flags enabled (PIC_GC_STRESS, VM_DEBUG, DEBUG)::
$ cmake -DCMAKE_BUILD_TYPE=Debug ..
Requirement
-----------
Picrin scheme depends on some external libraries to build the binary:
- perl
- lex (preferably, flex)
- getopt
- readline (optional)
- regex.h of POSIX.1 (optional)
Optional libraries are, if cmake detected them, automatically enabled.
The compilation is tested only on Mac OSX and Ubuntu. I think (or hope) it'll be ok to compile and run on other operating systems such as Arch or Windows, but I don't guarantee :(
Homepage
--------
@ -77,10 +23,15 @@ Currently picrin is hosted on Github. You can freely send a bug report or pull-r
https://github.com/wasabiz/picrin
Documentation
-------------
See http://picrin.readthedocs.org/
IRC
---
There is a chat room on chat.freenode.org, channel #picrin.
There is a chat room on chat.freenode.org, channel #picrin. IRC logs here: https://botbot.me/freenode/picrin/
LICENSE
-------

74
docs/lang.rst
View File

@ -1,75 +1,7 @@
Language
========
The language provided by picrin.
Libraries
---------
- ``(scheme base)``
- ``(scheme write)``
- ``(scheme cxr)``
- ``(scheme file)``
- ``(scheme inexact)``
- ``(scheme time)``
- ``(scheme process-context)``
- ``(scheme load)``
- ``(scheme lazy)``
- ``(picrin macro)``
- ``define-macro``
- ``gensym``
- ``macroexpand``
Old-fashioned macro.
- ``make-syntactic-closure``
- ``identifier?``
- ``identifier=?``
Syntactic closures.
- ``er-macro-transformer``
- ``ir-macro-transformer``
Explicit renaming macro family.
- ``(picrin regexp)``
- ``(regexp? obj)``
- ``(regexp ptrn [flags])``
Compiles pattern string into a regexp object. A string ``flags`` may contain any of #\g, #\i, #\m.
- ``(regexp-match re input)``
Returns two values: a list of match strings, and a list of match indeces.
- ``(regexp-replace re input txt)``
- ``(regexp-split re input)``
- ``(picrin control)``
- ``(reset h)``
- ``(shift k)``
Delimited control operators.
- ``(picrin user)``
When you start the REPL, you are dropped into here.
- ``(srfi 1)``
List manipulation library.
- ``(srfi 26)``
Cut/cute macros.
- ``(srfi 95)``
Sorting and Marging.
Picrin's core language is the R7RS scheme with some powerful extensions. Please visit http://r7rs.org/ for the information of R7RS's design and underlying thoughts.
The REPL
--------
@ -86,7 +18,7 @@ At the REPL start-up time, some usuful built-in libraries listed below will be a
- ``(scheme lazy)``
- ``(scheme time)``
Compiliance with R7RS
Compliance with R7RS
---------------------
================================================ ========== ==========================================================================================================================
@ -148,7 +80,7 @@ section status comments
6.11 Exceptions yes ``raise-continuable`` is not supported
6.12 Environments and evaluation N/A
6.13.1 Ports yes
6.13.2 Input incomplete TODO: binary input
6.13.2 Input yes
6.13.3 Output yes
6.14 System interface yes
================================================ ========== ==========================================================================================================================

119
docs/libs.rst Normal file
View File

@ -0,0 +1,119 @@
Libraries
=========
Picrin's all built-in libraries are described below.
Scheme standard libraries
-------------------------
- (scheme write)
- (scheme cxr)
- (scheme file)
- (scheme inexact)
- (scheme time)
- (scheme process-context)
- (scheme load)
- (scheme lazy)
SRFI libraries
--------------
- (srfi 1)
List manipulation library.
- (srfi 26)
Cut/cute macros.
- (srfi 95)
Sorting and Marging.
(picrin macro)
--------------
Utility functions and syntaces for macro definition.
- define-macro
- gensym
- macroexpand expr
Old-fashioned macro.
- make-syntactic-closure
- identifier?
- identifier=?
Syntactic closures.
- er-macro-transformer
- ir-macro-transformer
Explicit renaming macro family.
(picrin regexp)
---------------
- **(regexp ptrn [flags])**
Compiles pattern string into a regexp object. A string flags may contain any of #\g, #\i, #\m.
- **(regexp? obj)**
Judges if obj is a regexp object or not.
- **(regexp-match re input)**
Returns two values: a list of match strings, and a list of match indeces.
- **(regexp-replace re input txt)**
- **(regexp-split re input)**
(picrin control)
----------------
Delimited control operators.
- **(reset h)**
- **(shift k)**
(picrin dictionary)
-------------------
Symbol to Object table. Internally it is implemented on hash-table.
Note that dictionary is not a weak map; if you are going to make a highly memory-consuming program with dictionaries, you should know that dictionaries keep their bound objects and never let them free until you explicitly deletes bindings.
- **(dictionary)**
Returns a newly allocated empty dictionary. In the future, it is planned to extend this function to take optional arguments for initial key/values.
- **(dictionary? obj)**
Returns #t if obj is a dictionary.
- **(dictionary-ref dict key)**
Look up dictionary dict for a value associated with symbol key. If no object is associated with key, it will raise an error.
- **(dictionary-set! dict key obj)**
If there is no value already associated with key, this function newly creates a binding of key with obj. Otherwise, updates the existing binding with given obj.
- **(dictionary-delete dict key)**
Deletes the binding associated with key from dict. If no binding on dict is associated with key, an error will be raised.
- **(dictionary-size dict)**
Returns the number of registered elements in dict.
(picrin user)
-------------
When you start the REPL, you are dropped into here.

2
extlib/xhash

@ -1 +1 @@
Subproject commit 985d9af6188a1426788e56db03025847c32e519b
Subproject commit ddc2ea288b37b3f5de37024ff2648d11aa18811a

6
include/picrin/config.h
View File

@ -45,6 +45,10 @@
/* #define GC_DEBUG 1 */
/* #define GC_DEBUG_DETAIL 1 */
#if __STDC_VERSION__ < 199901L
# error please activate c99 features
#endif
#ifndef PIC_CONTRIB_INITS
# define PIC_CONTRIB_INITS
#endif
@ -56,7 +60,7 @@
#endif
#ifndef PIC_NAN_BOXING
# if __x86_64__
# if __x86_64__ && __STDC_VERSION__ >= 201112L
# define PIC_NAN_BOXING 1
# endif
#endif

24
include/picrin/dict.h Normal file
View File

@ -0,0 +1,24 @@
/**
* See Copyright Notice in picrin.h
*/
#ifndef PICRIN_DICT_H__
#define PICRIN_DICT_H__
#if defined(__cplusplus)
extern "C" {
#endif
struct pic_dict {
PIC_OBJECT_HEADER
xhash hash;
};
#define pic_dict_p(v) (pic_type(v) == PIC_TT_DICT)
#define pic_dict_ptr(v) ((struct pic_dict *)pic_ptr(v))
#if defined(__cplusplus)
}
#endif
#endif

2
include/picrin/util.h
View File

@ -28,7 +28,7 @@ extern "C" {
# define GENSYM(x) GENSYM1__(__LINE__,x)
#endif
#if __GNUC__ || __clang__
#if GCC_VERSION >= 40500 || __clang__
# define UNREACHABLE() (__builtin_unreachable())
#else
# include <assert.h>

8
include/picrin/value.h
View File

@ -116,7 +116,8 @@ enum pic_tt {
PIC_TT_VAR,
PIC_TT_IREP,
PIC_TT_DATA,
PIC_TT_BOX
PIC_TT_BOX,
PIC_TT_DICT
};
#define PIC_OBJECT_HEADER \
@ -146,7 +147,8 @@ typedef struct pic_blob pic_blob;
#define pic_sym(v) ((v).u.sym)
#define pic_char(v) ((v).u.c)
#define pic_obj_ptr(o) ((struct pic_object *)pic_ptr(o))
#define pic_obj_p(v) (pic_vtype(v) == PIC_VTYPE_HEAP)
#define pic_obj_ptr(v) ((struct pic_object *)pic_ptr(v))
#define pic_nil_p(v) (pic_vtype(v) == PIC_VTYPE_NIL)
#define pic_true_p(v) (pic_vtype(v) == PIC_VTYPE_TRUE)
@ -269,6 +271,8 @@ pic_type_repr(enum pic_tt tt)
return "data";
case PIC_TT_BOX:
return "box";
case PIC_TT_DICT:
return "dict";
}
UNREACHABLE();
}

18
piclib/built-in.scm
View File

@ -263,10 +263,14 @@
,(let loop ((clauses clauses))
(if (null? clauses)
#f
`(,(r 'if) (,(r 'or)
,@(map (lambda (x) `(,(r 'eqv?) ,(r 'key) (,(r 'quote) ,x)))
(caar clauses)))
(begin ,@(cdar clauses))
`(,(r 'if) ,(if (compare (r 'else) (caar clauses))
'#t
`(,(r 'or)
,@(map (lambda (x) `(,(r 'eqv?) ,(r 'key) (,(r 'quote) ,x)))
(caar clauses))))
,(if (compare (r '=>) (cadar clauses))
`(,(caddar clauses) ,(r 'key))
`(,(r 'begin) ,@(cdar clauses)))
,(loop (cdr clauses))))))))))
(define-syntax syntax-error
@ -729,7 +733,7 @@
(end (if (>= (length opts) 2)
(cadr opts)
(vector-length v))))
(let ((res (make-vector (vector-length v))))
(let ((res (make-vector (- end start))))
(vector-copy! res 0 v start end)
res)))
@ -788,7 +792,7 @@
(end (if (>= (length opts) 2)
(cadr opts)
(bytevector-length v))))
(let ((res (make-bytevector (bytevector-length v))))
(let ((res (make-bytevector (- end start))))
(bytevector-copy! res 0 v start end)
res)))
@ -798,7 +802,7 @@
(bytevector-copy! res 0 v)
(bytevector-copy! res (bytevector-length v) w)
res))
(fold bytevector-append-2-inv #() vs))
(fold bytevector-append-2-inv #u8() vs))
(define (bytevector->list v start end)
(do ((i start (+ i 1))

15
src/codegen.c
View File

@ -294,7 +294,7 @@ analyze_global_var(analyze_state *state, pic_sym sym)
xh_entry *e;
size_t i;
if ((e = xh_get(&pic->global_tbl, sym))) {
if ((e = xh_get_int(&pic->global_tbl, sym))) {
i = xh_val(e, size_t);
}
else {
@ -302,7 +302,7 @@ analyze_global_var(analyze_state *state, pic_sym sym)
if (i >= pic->gcapa) {
pic_error(pic, "global table overflow");
}
xh_put(&pic->global_tbl, sym, &i);
xh_put_int(&pic->global_tbl, sym, &i);
}
return pic_list2(pic, pic_symbol_value(state->sGREF), pic_int_value(i));
}
@ -561,7 +561,7 @@ analyze_add(analyze_state *state, pic_value obj, bool tailpos)
ARGC_ASSERT_GE(0);
switch (pic_length(pic, obj)) {
case 1:
return pic_int_value(0);
return pic_list2(pic, pic_symbol_value(pic->sQUOTE), pic_int_value(0));
case 2:
return analyze(state, pic_car(pic, pic_cdr(pic, obj)), tailpos);
default:
@ -598,7 +598,7 @@ analyze_mul(analyze_state *state, pic_value obj, bool tailpos)
ARGC_ASSERT_GE(0);
switch (pic_length(pic, obj)) {
case 1:
return pic_int_value(1);
return pic_list2(pic, pic_symbol_value(pic->sQUOTE), pic_int_value(1));
case 2:
return analyze(state, pic_car(pic, pic_cdr(pic, obj)), tailpos);
default:
@ -825,6 +825,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
case PIC_TT_IREP:
case PIC_TT_DATA:
case PIC_TT_BOX:
case PIC_TT_DICT:
pic_errorf(pic, "invalid expression given: ~s", obj);
}
UNREACHABLE();
@ -929,18 +930,18 @@ create_activation(codegen_context *cxt)
for (i = 0; i < cxt->args.size; ++i) {
var = xv_get(&cxt->args, i);
n = i + offset;
xh_put(&regs, *var, &n);
xh_put_int(&regs, *var, &n);
}
offset += i;
for (i = 0; i < cxt->locals.size; ++i) {
var = xv_get(&cxt->locals, i);
n = i + offset;
xh_put(&regs, *var, &n);
xh_put_int(&regs, *var, &n);
}
for (i = 0; i < cxt->captures.size; ++i) {
var = xv_get(&cxt->captures, i);
if ((n = xh_val(xh_get(&regs, *var), size_t)) <= cxt->args.size || (cxt->varg && n == cxt->args.size + 1)) {
if ((n = xh_val(xh_get_int(&regs, *var), size_t)) <= cxt->args.size || (cxt->varg && n == cxt->args.size + 1)) {
/* copy arguments to capture variable area */
cxt->code[cxt->clen].insn = OP_LREF;
cxt->code[cxt->clen].u.i = n;

100
src/dict.c Normal file
View File

@ -0,0 +1,100 @@
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
#include "picrin/dict.h"
static pic_value
pic_dict_dict(pic_state *pic)
{
struct pic_dict *dict;
pic_get_args(pic, "");
dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT);
xh_init_int(&dict->hash, sizeof(pic_value));
return pic_obj_value(dict);
}
static pic_value
pic_dict_dict_p(pic_state *pic)
{
pic_value obj;
pic_get_args(pic, "o", &obj);
return pic_bool_value(pic_dict_p(obj));
}
static pic_value
pic_dict_dict_ref(pic_state *pic)
{
struct pic_dict *dict;
pic_sym key;
xh_entry *e;
pic_get_args(pic, "dm", &dict, &key);
e = xh_get_int(&dict->hash, key);
if (! e) {
pic_errorf(pic, "element not found for a key: ~s", pic_sym_value(key));
}
return xh_val(e, pic_value);
}
static pic_value
pic_dict_dict_set(pic_state *pic)
{
struct pic_dict *dict;
pic_sym key;
pic_value val;
pic_get_args(pic, "dmo", &dict, &key, &val);
xh_put_int(&dict->hash, key, &val);
return pic_none_value();
}
static pic_value
pic_dict_dict_del(pic_state *pic)
{
struct pic_dict *dict;
pic_sym key;
pic_get_args(pic, "dm", &dict, &key);
if (xh_get_int(&dict->hash, key) == NULL) {
pic_errorf(pic, "no slot named ~s found in dictionary", pic_sym_value(key));
}
xh_del_int(&dict->hash, key);
return pic_none_value();
}
static pic_value
pic_dict_dict_size(pic_state *pic)
{
struct pic_dict *dict;
pic_get_args(pic, "d", &dict);
return pic_int_value(dict->hash.count);
}
void
pic_init_dict(pic_state *pic)
{
pic_deflibrary ("(picrin dictionary)") {
pic_defun(pic, "dictionary", pic_dict_dict);
pic_defun(pic, "dictionary?", pic_dict_dict_p);
pic_defun(pic, "dictionary-ref", pic_dict_dict_ref);
pic_defun(pic, "dictionary-set!", pic_dict_dict_set);
pic_defun(pic, "dictionary-delete", pic_dict_dict_del);
pic_defun(pic, "dictionary-size", pic_dict_dict_size);
}
}

19
src/gc.c
View File

@ -20,6 +20,7 @@
#include "picrin/var.h"
#include "picrin/data.h"
#include "picrin/box.h"
#include "picrin/dict.h"
#if GC_DEBUG
# include <string.h>
@ -504,6 +505,16 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
gc_mark(pic, box->value);
break;
}
case PIC_TT_DICT: {
struct pic_dict *dict = (struct pic_dict *)obj;
xh_iter it;
xh_begin(&it, &dict->hash);
while (xh_next(&it)) {
gc_mark(pic, xh_val(it.e, pic_value));
}
break;
}
case PIC_TT_NIL:
case PIC_TT_BOOL:
case PIC_TT_FLOAT:
@ -533,8 +544,7 @@ gc_mark_phase(pic_state *pic)
{
pic_value *stack;
pic_callinfo *ci;
size_t i;
int j;
size_t i, j;
xh_iter it;
/* block */
@ -658,6 +668,11 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
case PIC_TT_BOX: {
break;
}
case PIC_TT_DICT: {
struct pic_dict *dict = (struct pic_dict *)obj;
xh_destroy(&dict->hash);
break;
}
case PIC_TT_NIL:
case PIC_TT_BOOL:
case PIC_TT_FLOAT:

2
src/init.c
View File

@ -29,6 +29,7 @@ void pic_init_macro(pic_state *);
void pic_init_var(pic_state *);
void pic_init_load(pic_state *);
void pic_init_write(pic_state *);
void pic_init_dict(pic_state *);
void pic_load_piclib(pic_state *);
@ -93,6 +94,7 @@ pic_init_core(pic_state *pic)
pic_init_var(pic); DONE;
pic_init_load(pic); DONE;
pic_init_write(pic); DONE;
pic_init_dict(pic); DONE;
pic_load_piclib(pic); DONE;

53
src/lib.c
View File

@ -60,3 +60,56 @@ pic_find_library(pic_state *pic, pic_value spec)
}
return pic_lib_ptr(pic_cdr(pic, v));
}
void
pic_import(pic_state *pic, pic_value spec)
{
struct pic_lib *lib;
xh_iter it;
lib = pic_find_library(pic, spec);
if (! lib) {
pic_errorf(pic, "library not found: ~a", spec);
}
xh_begin(&it, &lib->exports);
while (xh_next(&it)) {
#if DEBUG
printf("* importing %s as %s\n", pic_symbol_name(pic, xh_key(it.e, pic_sym)), pic_symbol_name(pic, xh_val(it.e, pic_sym)));
#endif
pic_put_rename(pic, pic->lib->senv, xh_key(it.e, pic_sym), xh_val(it.e, pic_sym));
}
}
void
pic_export(pic_state *pic, pic_sym sym)
{
pic_sym rename;
if (! pic_find_rename(pic, pic->lib->senv, sym, &rename)) {
pic_errorf(pic, "export: symbol not defined %s", pic_symbol_name(pic, sym));
}
#if DEBUG
printf("* exporting %s as %s\n", pic_symbol_name(pic, sym), pic_symbol_name(pic, rename));
#endif
xh_put_int(&pic->lib->exports, sym, &rename);
}
void
pic_export_as(pic_state *pic, pic_sym sym, pic_sym as)
{
pic_sym rename;
if (! pic_find_rename(pic, pic->lib->senv, sym, &rename)) {
pic_errorf(pic, "export: symbol not defined %s", pic_symbol_name(pic, sym));
}
#if DEBUG
printf("* exporting %s as %s\n", pic_symbol_name(pic, as), pic_symbol_name(pic, rename));
#endif
xh_put_int(&pic->lib->exports, as, &rename);
}

70
src/macro.c
View File

@ -52,7 +52,7 @@ pic_put_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym, pic_sym renam
{
UNUSED(pic);
xh_put(&senv->renames, sym, &rename);
xh_put_int(&senv->renames, sym, &rename);
}
bool
@ -62,7 +62,7 @@ pic_find_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym, pic_sym *ren
UNUSED(pic);
if ((e = xh_get(&senv->renames, sym)) == NULL) {
if ((e = xh_get_int(&senv->renames, sym)) == NULL) {
return false;
}
if (rename != NULL) {
@ -71,43 +71,6 @@ pic_find_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym, pic_sym *ren
return true;
}
void
pic_import(pic_state *pic, pic_value spec)
{
struct pic_lib *lib;
xh_iter it;
lib = pic_find_library(pic, spec);
if (! lib) {
pic_errorf(pic, "library not found: ~a", spec);
}
xh_begin(&it, &lib->exports);
while (xh_next(&it)) {
#if DEBUG
printf("* importing %s as %s\n", pic_symbol_name(pic, xh_key(it.e, pic_sym)), pic_symbol_name(pic, xh_val(it.e, pic_sym)));
#endif
pic_put_rename(pic, pic->lib->senv, xh_key(it.e, pic_sym), xh_val(it.e, pic_sym));
}
}
void
pic_export(pic_state *pic, pic_sym sym)
{
pic_sym rename;
if (! pic_find_rename(pic, pic->lib->senv, sym, &rename)) {
pic_errorf(pic, "export: symbol not defined %s", pic_symbol_name(pic, sym));
}
#if DEBUG
printf("* exporting %s as %s\n", pic_symbol_name(pic, sym), pic_symbol_name(pic, rename));
#endif
xh_put(&pic->lib->exports, sym, &rename);
}
static void
define_macro(pic_state *pic, pic_sym rename, struct pic_proc *proc, struct pic_senv *senv)
{
@ -117,7 +80,7 @@ define_macro(pic_state *pic, pic_sym rename, struct pic_proc *proc, struct pic_s
mac->senv = senv;
mac->proc = proc;
xh_put(&pic->macros, rename, &mac);
xh_put_int(&pic->macros, rename, &mac);
}
static struct pic_macro *
@ -125,7 +88,7 @@ find_macro(pic_state *pic, pic_sym rename)
{
xh_entry *e;
if ((e = xh_get(&pic->macros, rename)) == NULL) {
if ((e = xh_get_int(&pic->macros, rename)) == NULL) {
return NULL;
}
return xh_val(e, struct pic_macro *);
@ -304,14 +267,34 @@ macroexpand_import(pic_state *pic, pic_value expr)
static pic_value
macroexpand_export(pic_state *pic, pic_value expr)
{
extern pic_value pic_export_as(pic_state *, pic_sym, pic_sym);
pic_value spec;
pic_sym sRENAME, sym, as;
sRENAME = pic_intern_cstr(pic, "rename");
pic_for_each (spec, pic_cdr(pic, expr)) {
if (! pic_sym_p(spec)) {
if (pic_sym_p(spec)) {
sym = as = pic_sym(spec);
}
else if (pic_list_p(spec) && pic_eq_p(pic_car(pic, spec), pic_sym_value(sRENAME))) {
if (pic_length(pic, spec) != 3) {
pic_error(pic, "syntax error");
}
if (! pic_sym_p(pic_list_ref(pic, spec, 1))) {
pic_error(pic, "syntax error");
}
sym = pic_sym(pic_list_ref(pic, spec, 1));
if (! pic_sym_p(pic_list_ref(pic, spec, 2))) {
pic_error(pic, "syntax error");
}
as = pic_sym(pic_list_ref(pic, spec, 2));
}
else {
pic_error(pic, "syntax error");
}
/* TODO: warn if symbol is shadowed by local variable */
pic_export(pic, pic_sym(spec));
pic_export_as(pic, sym, as);
}
return pic_none_value();
@ -586,6 +569,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_valu
case PIC_TT_IREP:
case PIC_TT_DATA:
case PIC_TT_BOX:
case PIC_TT_DICT:
pic_errorf(pic, "unexpected value type: ~s", expr);
}
UNREACHABLE();

2
src/number.c
View File

@ -224,7 +224,7 @@ pic_number_max(pic_state *pic)
f = fmax(f, pic_float(argv[i]));
}
else {
pic_error(pic, "min: number required");
pic_error(pic, "max: number required");
}
}

142
src/port.c
View File

@ -434,6 +434,136 @@ pic_port_char_ready_p(pic_state *pic)
return pic_true_value(); /* FIXME: always returns #t */
}
static pic_value
pic_port_read_string(pic_state *pic){
struct pic_port *port = pic_stdin(pic), *buf;
pic_str *str;
int k, i;
char c;
pic_get_args(pic, "i|p", &k, &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, PIC_PORT_OPEN, "read-stritg");
buf = pic_open_output_string(pic);
for(i = 0; i < k; ++i) {
c = xfgetc(port->file);
if( c == EOF){
break;
}
xfputc(c, buf->file);
}
str = pic_get_output_string(pic, buf);
if (pic_strlen(str) == 0 && c == EOF) {
return pic_eof_object();
}
else {
return pic_obj_value(str);
}
}
static pic_value
pic_port_read_byte(pic_state *pic){
struct pic_port *port = pic_stdin(pic);
char c;
pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-u8");
if ((c = xfgetc(port->file)) == EOF) {
return pic_eof_object();
}
return pic_int_value(c);
}
static pic_value
pic_port_peek_byte(pic_state *pic)
{
char c;
struct pic_port *port = pic_stdin(pic);
pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "peek-u8");
if ((c = xfgetc(port->file)) == EOF) {
return pic_eof_object();
}
else {
xungetc(c, port->file);
return pic_int_value(c);
}
}
static pic_value
pic_port_byte_ready_p(pic_state *pic)
{
struct pic_port *port = pic_stdin(pic);
pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "u8-ready?");
return pic_true_value(); /* FIXME: always returns #t */
}
static pic_value
pic_port_read_blob(pic_state *pic){
struct pic_port *port = pic_stdin(pic);
int k, i;
char *buf;
pic_get_args(pic, "i|p", &k, &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector");
buf = pic_calloc(pic, k, sizeof(char));
i = xfread(buf, sizeof(char), k, port->file);
if ( i == 0 ) {
return pic_eof_object();
}
else {
pic_realloc(pic, buf, i);
return pic_obj_value(pic_blob_new(pic, buf, i));
}
}
static pic_value
pic_port_read_blob_ip(pic_state *pic){
struct pic_port *port;
struct pic_blob *bv;
int i, n, start, end, len;
char *buf;
n = pic_get_args(pic, "b|pii", &bv, &port, &start, &end);
switch (n) {
case 1:
port = pic_stdin(pic);
case 2:
start = 0;
case 3:
end = bv->len;
}
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector!");
len = end - start;
buf = pic_calloc(pic, len, sizeof(char));
i = xfread(buf, sizeof(char), len, port->file);
memcpy(bv->data + start, buf, i);
pic_free(pic, buf);
if ( i == 0) {
return pic_eof_object();
}
else {
return pic_int_value(i);
}
}
static pic_value
pic_port_newline(pic_state *pic)
{
@ -571,12 +701,12 @@ pic_init_port(pic_state *pic)
pic_defun(pic, "eof-object?", pic_port_eof_object_p);
pic_defun(pic, "eof-object", pic_port_eof_object);
pic_defun(pic, "char-ready?", pic_port_char_ready_p);
/* pic_defun(pic, "read-string", pic_port_read_string); */
/* pic_defun(pic, "read-u8", pic_port_read_byte); */
/* pic_defun(pic, "peek-u8", pic_port_peek_byte); */
/* pic_defun(pic, "u8-ready?", pic_port_byte_ready_p); */
/* pic_defun(pic, "read-bytevector", pic_port_read_blob); */
/* pic_defun(pic, "peek-bytevector!", pic_port_read_blob_ip); */
pic_defun(pic, "read-string", pic_port_read_string);
pic_defun(pic, "read-u8", pic_port_read_byte);
pic_defun(pic, "peek-u8", pic_port_peek_byte);
pic_defun(pic, "u8-ready?", pic_port_byte_ready_p);
pic_defun(pic, "read-bytevector", pic_port_read_blob);
pic_defun(pic, "read-bytevector!", pic_port_read_blob_ip);
/* output */
pic_defun(pic, "newline", pic_port_newline);

8
src/read.c
View File

@ -53,7 +53,7 @@ read_label_set(int i, yyscan_t scanner)
val = pic_cons(pic, pic_none_value(), pic_none_value());
xh_put(&yylabels, i, &val);
xh_put_int(&yylabels, i, &val);
tmp = read(tok, scanner);
pic_pair_ptr(val)->car = pic_car(pic, tmp);
@ -67,7 +67,7 @@ read_label_set(int i, yyscan_t scanner)
val = pic_obj_value(pic_vec_new(pic, 0));
xh_put(&yylabels, i, &val);
xh_put_int(&yylabels, i, &val);
tmp = pic_vec_ptr(read(tok, scanner));
SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data);
@ -79,7 +79,7 @@ read_label_set(int i, yyscan_t scanner)
{
val = read(tok, scanner);
xh_put(&yylabels, i, &val);
xh_put_int(&yylabels, i, &val);
return val;
}
@ -91,7 +91,7 @@ read_label_ref(int i, yyscan_t scanner)
{
xh_entry *e;
e = xh_get(&yylabels, i);
e = xh_get_int(&yylabels, i);
if (! e) {
error("label of given index not defined", scanner);
}

4
src/scan.l
View File

@ -33,6 +33,9 @@
%option extra-type="struct parser_control *"
%option never-interactive
/* shebang */
shebang #!.*$
/* comment */
comment ;.*$
@ -71,6 +74,7 @@ label #{uinteger}
[ \t\n\r] /* skip whitespace */
{comment} /* skip comment */
{shebang} /* skip shebang */
"#|" {
BEGIN(BLOCK_COMMENT);

6
src/symbol.c
View File

@ -27,7 +27,7 @@ pic_intern(pic_state *pic, const char *str, size_t len)
id = pic->sym_cnt++;
xh_put(&pic->syms, cstr, &id);
xh_put(&pic->sym_names, id, &cstr);
xh_put_int(&pic->sym_names, id, &cstr);
return id;
}
@ -50,7 +50,7 @@ pic_gensym(pic_state *pic, pic_sym base)
/* don't put the symbol to pic->syms to keep it uninterned */
uniq = pic->sym_cnt++;
xh_put(&pic->sym_names, uniq, &str);
xh_put_int(&pic->sym_names, uniq, &str);
return uniq;
}
@ -64,7 +64,7 @@ pic_interned_p(pic_state *pic, pic_sym sym)
const char *
pic_symbol_name(pic_state *pic, pic_sym sym)
{
return xh_val(xh_get(&pic->sym_names, sym), const char *);
return xh_val(xh_get_int(&pic->sym_names, sym), const char *);
}
static pic_value

44
src/vm.c
View File

@ -19,6 +19,7 @@
#include "picrin/lib.h"
#include "picrin/macro.h"
#include "picrin/error.h"
#include "picrin/dict.h"
#define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)])
@ -33,6 +34,28 @@ pic_get_proc(pic_state *pic)
return pic_proc_ptr(v);
}
/**
* char type
* ---- ----
* o object
* i int
* I int with exactness
* f float
* F float with exactness
* s string object
* z c string
* m symbol
* v vector object
* b bytevector object
* c char
* l lambda object
* p port object
* d dictionary object
*
* | optional operator
* * variable length operator
*/
int
pic_get_args(pic_state *pic, const char *format, ...)
{
@ -306,6 +329,23 @@ pic_get_args(pic_state *pic, const char *format, ...)
}
break;
}
case 'd': {
struct pic_dict **d;
pic_value v;
d = va_arg(ap, struct pic_dict **);
if (i < argc) {
v = GET_OPERAND(pic,i);
if (pic_dict_p(v)) {
*d = pic_dict_ptr(v);
}
else {
pic_error(pic, "pic_get_args, expected dictionary");
}
i++;
}
break;
}
default:
pic_error(pic, "pic_get_args: invalid argument specifier given");
}
@ -339,7 +379,7 @@ global_ref(pic_state *pic, const char *name)
if (! pic_find_rename(pic, pic->lib->senv, sym, &rename)) {
return SIZE_MAX;
}
if (! (e = xh_get(&pic->global_tbl, rename))) {
if (! (e = xh_get_int(&pic->global_tbl, rename))) {
return SIZE_MAX;
}
return xh_val(e, size_t);
@ -365,7 +405,7 @@ global_def(pic_state *pic, const char *name)
if (pic->glen >= pic->gcapa) {
pic_error(pic, "global table overflow");
}
xh_put(&pic->global_tbl, rename, &gidx);
xh_put_int(&pic->global_tbl, rename, &gidx);
return gidx;
}

3
src/write.c
View File

@ -338,6 +338,9 @@ write_core(struct writer_control *p, pic_value obj)
case PIC_TT_BOX:
xfprintf(file, "#<box %p>", pic_ptr(obj));
break;
case PIC_TT_DICT:
xfprintf(file, "#<dict %p>", pic_ptr(obj));
break;
}
}

34
t/byteio.scm Normal file
View File

@ -0,0 +1,34 @@
(import (scheme base)
(scheme write)
(scheme file))
(let ((string-port (open-input-string "hello")))
(display "read-string: ")
(write (read-string 4 string-port))
(newline)
(display "read-string more: ")
(write (read-string 4 string-port))
(newline))
(let ((byte-port (open-input-bytevector (bytevector 1 2 3 4 5 6 7 8)))
(buf (make-bytevector 4 98)))
(display "read-u8: ")
(write (read-u8 byte-port))
(newline)
(display "peek-u8: ")
(write (peek-u8 byte-port))
(newline)
(display "read-bytevector: ")
(write (read-bytevector 4 byte-port))
(newline)
(display "read-bytevector!: read size: ")
(write (read-bytevector! buf byte-port 1 3))
(display ": read content: ")
(write buf)
(newline)
(display "read-bytevector!: read size: ")
(write (read-bytevector! buf byte-port))
(display ": read content: ")
(write buf)
(newline))

9
t/shebang.scm Executable file
View File

@ -0,0 +1,9 @@
#! /bin/sh
#| -*- scheme -*-
exec picrin $0 "$@"
|#
(import (scheme base)
(scheme write))
(write (list 1 2 3))

2
tools/CMakeLists.txt
View File

@ -1,6 +1,6 @@
list(APPEND REPL_LIBRARIES picrin)
find_package(LIBEDIT)
find_package(Libedit)
if (Libedit_FOUND)
include_directories(${Libedit_INCLUDE_DIRS})
add_definitions(${Libedit_DEFINITIONS} -DPIC_READLINE_FOUND=1)