Compare commits

...

4 Commits

Author SHA1 Message Date
4e7ddffbc6 rust runtime 2026-05-19 16:16:03 -06:00
78a4fb402d 2026-05-19 16:16:03 -06:00
c1851fe242 2026-05-19 16:16:03 -06:00
fbcb129437 2026-05-19 16:16:03 -06:00
22 changed files with 444 additions and 232 deletions

View File

@@ -284,6 +284,8 @@ lowerVal
lowerVal (ValLit (LitInt n)) k = k . lowerInt $ n
-- lowerVal (ValLit (LitQuote (SexpSymbol s))) k = _aaa
lowerVal (ValLit (LitString s)) k = do
rawString <- gensym
r <- gensym

View File

@@ -2,11 +2,21 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PartialTypeSignatures #-}
module Gyehoek.Scheme.Syntax where
module Gyehoek.Scheme.Syntax
( Name
, Prim(..)
, Lit(..)
, Define(..)
, Exp(..)
, Sexp(..)
)
where
import Data.Text (Text)
import Data.List (List)
import Language.SexpGrammar as Sexp hiding (List)
import Language.SexpGrammar
( SexpIso(..), list, el, (>>>), rest, sym, symbol )
import Language.SexpGrammar qualified as Sexp
import Language.SexpGrammar.Generic
import GHC.Generics
import Prelude hiding ((.), id)
@@ -39,6 +49,7 @@ data Lit
| LitNil
| LitBool Bool
| LitString Text
| LitQuote Sexp
deriving (Show, Generic)
data Define
@@ -53,9 +64,15 @@ data Exp
| ExpDefine Define
| ExpIf Exp Exp Exp
| ExpLit Lit
| ExpApply Exp (List Exp)
| ExpLambda (List Name) Exp
| ExpVar Name
| ExpApply Exp (List Exp)
deriving (Show, Generic)
data Sexp
= SexpCons Sexp Sexp
| SexpSymbol Text
| SexpLit Lit
deriving (Show, Generic)
@@ -85,6 +102,14 @@ instance SexpIso Lit where
$ With (. sym "nil")
$ With (. sexpIso)
$ With (. sexpIso)
$ With (. Gyehoek.Sexp.prefixSugar "quote" Sexp.Quote sexpIso)
$ End
instance SexpIso Sexp where
sexpIso = match
$ With (\cons -> cons . Gyehoek.Sexp.todo)
$ With (\s -> s . symbol)
$ With (\lit -> lit . sexpIso)
$ End
instance SexpIso Define where
@@ -105,9 +130,9 @@ instance SexpIso Exp where
$ With (. sexpIso)
$ With (. if_)
$ With (. sexpIso)
$ With (\app -> app . list (el sexpIso >>> rest sexpIso))
$ With (. lam)
$ With (. symbol)
$ With (\app -> app . list (el sexpIso >>> rest sexpIso))
$ End
where
if_ = list $ el (sym "if") >>> el sexpIso >>> el sexpIso >>> el sexpIso

View File

@@ -10,6 +10,8 @@ module Gyehoek.Sexp
, encode
, decode
, parseSexps
, prefixSugar
, todo
)
where
@@ -33,6 +35,7 @@ import GHC.IO.Unsafe (unsafePerformIO)
import qualified Data.Text.IO as TIO
import Control.Monad (join)
import qualified Language.Sexp.Located as SexpLoc
import Data.Void (absurd)
sexp :: SexpIso a => Iso' a Text
@@ -80,6 +83,24 @@ dotlist x = list $ rest $ coproduct
[ x >>> _
]
-- | Define a sexp representation as either (⟨name⟩ ⟨e⟩) or '⟨e⟩.
prefixSugar
:: Text -> Prefix
-> Grammar Position (Sexp :- t') a
-> Grammar Position (Sexp :- t') a
prefixSugar name prefix e = coproduct
-- 'something
[ Sexp.prefixed prefix e
-- (quote something)
, list $ el (sym name) >>> el e
]
todo :: Grammar p (Sexp :- t) t'
todo = (IGB.Flip $ IGB.PartialIso absurd f) >>> IGB.PartialIso absurd g
where
f _ = Left $ unexpected "todo"
g _ = Left $ unexpected "todo"
lambda
:: (forall t. Grammar Position (Sexp :- t) (a :- t))
-> Grammar Position (Sexp :- List a :- t1) t2

View File

@@ -120,5 +120,5 @@ driver = runGenSym . traverseOf_ (#sourceFiles . folded) \f -> do
anfs <- toANF f exps
qbe <- toQBE f anfs
callQBE f
callGCC f ["../runtime/gyehoek.c"]
callGCC f ["../runtime/target/debug/libgyehoek.a"]
pure ()

View File

@@ -40,6 +40,8 @@
pkg-config
guile
clang-tools # clangd
gdb
gdbgui
];
};
};

Binary file not shown.

BIN
play/hash Executable file

Binary file not shown.

48
play/hash.c Normal file
View File

@@ -0,0 +1,48 @@
#include <stdio.h>
#include <string.h>
#include "../runtime/gyehoek.h"
#include "../runtime/weak-set.h"
static int
symbol_lookup_predicate_fn (SCM sym1, void *closure) {
const SCM sym2 = *((SCM*)closure);
const int symp1 = SCM_SYMBOLP (sym1);
const int symp2 = SCM_SYMBOLP (sym2);
// both symbols?
if (SCM_SYMBOLP (sym1) && SCM_SYMBOLP (sym2)) {
const SCM str1 = SCM_CELL_OBJECT (sym1, 2);
const SCM str2 = SCM_CELL_OBJECT (sym2, 2);
const size_t len1 = scm_c_string_length (str1);
const size_t len2 = scm_c_string_length (str2);
// same length?
if (len1 == len2) {
// same name?
const char * const s1 = scm_c_string_chars (str1);
const char * const s2 = scm_c_string_chars (str2);
return strncmp (s1, s2, len1);
}
}
return 0;
}
SCM test (SCM set, const char *sym_name, SCM value) {
SCM str = scm_from_cstring (sym_name);
SCM sym = scm_make_symbol (str, scm_c_hash (str));
SCM r = scm_c_weak_set_insert (set, scm_c_hash (str), value,
symbol_lookup_predicate_fn,
&sym);
printf ("%ld\n", weak_set_count (set));
return r;
}
int main () {
/* const char s[] = "wormy"; */
/* const SCM str = scm_from_utf8_string (s, sizeof(s)); */
/* const unsigned long hash = scm_c_hash (str); */
/* printf ("%ld\n", hash); */
SCM set = scm_c_make_weak_set (31);
test (set, "my-symbol", SCM_PACK (SCM_MAKE_SMALL_INT (123)));
test (set, "my-symbol", SCM_PACK (SCM_MAKE_SMALL_INT (123)));
test (set, "my-symbol2", SCM_PACK (SCM_MAKE_SMALL_INT (456)));
}

BIN
play/t

Binary file not shown.

1
runtime/.envrc Normal file
View File

@@ -0,0 +1 @@
use flake

1
runtime/.gitignore vendored Normal file
View File

@@ -0,0 +1 @@
target

56
runtime/Cargo.lock generated Normal file
View File

@@ -0,0 +1,56 @@
# This file is automatically @generated by Cargo.
# It is not intended for manual editing.
version = 4
[[package]]
name = "bdwgc-alloc"
version = "0.6.13"
source = "git+https://git.deertopia.net/msyds/bdwgc-rust.git#ccc273a168f3ddfee0a2ae170f561f19da8c274a"
dependencies = [
"cmake",
"libc",
]
[[package]]
name = "cc"
version = "1.2.62"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "a1dce859f0832a7d088c4f1119888ab94ef4b5d6795d1ce05afb7fe159d79f98"
dependencies = [
"find-msvc-tools",
"shlex",
]
[[package]]
name = "cmake"
version = "0.1.58"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "c0f78a02292a74a88ac736019ab962ece0bc380e3f977bf72e376c5d78ff0678"
dependencies = [
"cc",
]
[[package]]
name = "find-msvc-tools"
version = "0.1.9"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "5baebc0774151f905a1a2cc41989300b1e6fbb29aff0ceffa1064fdd3088d582"
[[package]]
name = "gyehoek"
version = "0.1.0"
dependencies = [
"bdwgc-alloc",
]
[[package]]
name = "libc"
version = "0.2.186"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "68ab91017fe16c622486840e4c83c9a37afeff978bd239b5293d61ece587de66"
[[package]]
name = "shlex"
version = "1.3.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64"

17
runtime/Cargo.toml Normal file
View File

@@ -0,0 +1,17 @@
[package]
name = "gyehoek"
version = "0.1.0"
edition = "2024"
[lib]
name = "gyehoek"
# crate-type = ["cdylib"]
crate-type = ["staticlib"]
[dependencies]
bdwgc-alloc = { version = "0.6.13"
, default-features = false
, features = ["cmake"] }
[patch.crates-io]
bdwgc-alloc = { git = 'https://git.deertopia.net/msyds/bdwgc-rust.git' }

View File

@@ -1,8 +0,0 @@
all: gyehoek.o
gyehoek.o: gyehoek.c
$(CC) $(CFLAGS) -c gyehoek.c -o gyehoek.o
.PHONY: install
install:
install -Dm644 -t $(out)/lib gyehoek.o

View File

@@ -1,10 +0,0 @@
{ stdenv
, callPackage
, bdwgc ? callPackage ../bdwgc.nix {}
}:
stdenv.mkDerivation {
pname = "gyehoek";
version = "1.0.0";
src = ./.;
}

87
runtime/flake.lock generated Normal file
View File

@@ -0,0 +1,87 @@
{
"nodes": {
"fenix": {
"inputs": {
"nixpkgs": [
"nixpkgs"
],
"rust-analyzer-src": "rust-analyzer-src"
},
"locked": {
"lastModified": 1779185128,
"narHash": "sha256-Kl2bkmwZJD3n2KWDxuIlturZ7emqRK+anpD1LmDwpmY=",
"owner": "nix-community",
"repo": "fenix",
"rev": "b7bd9323fe26a3b4f4bddbb2c2a1dacabced2f88",
"type": "github"
},
"original": {
"owner": "nix-community",
"repo": "fenix",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1778869304,
"narHash": "sha256-30sZNZoA1cqF5JNO9fVX+wgiQYjB7HJqqJ4ztCDeBZE=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "d233902339c02a9c334e7e593de68855ad26c4cb",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixos-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"fenix": "fenix",
"nixpkgs": "nixpkgs",
"sydpkgs": "sydpkgs"
}
},
"rust-analyzer-src": {
"flake": false,
"locked": {
"lastModified": 1779074864,
"narHash": "sha256-0M3WqsWmtXmv9Ev/vnFfCHosWvISDwiuuhQ104UO3CI=",
"owner": "rust-lang",
"repo": "rust-analyzer",
"rev": "cdfe408d4b436e806ff525cb3e67588a6a009ed1",
"type": "github"
},
"original": {
"owner": "rust-lang",
"ref": "nightly",
"repo": "rust-analyzer",
"type": "github"
}
},
"sydpkgs": {
"inputs": {
"nixpkgs": [
"nixpkgs"
]
},
"locked": {
"lastModified": 1778962331,
"narHash": "sha256-qMokSV7hsWYiDCkkBGyG0aD4Ds3JLzJzJ0Cp9f/spJU=",
"ref": "refs/heads/main",
"rev": "59d3a471cd960f9d1f6c645a4fe578a670848e9d",
"revCount": 41,
"type": "git",
"url": "https://git.deertopia.net/msyds/sydpkgs"
},
"original": {
"type": "git",
"url": "https://git.deertopia.net/msyds/sydpkgs"
}
}
},
"root": "root",
"version": 7
}

70
runtime/flake.nix Normal file
View File

@@ -0,0 +1,70 @@
{
inputs = {
nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
fenix = {
url = "github:nix-community/fenix";
inputs.nixpkgs.follows = "nixpkgs";
};
sydpkgs = {
url = "git+https://git.deertopia.net/msyds/sydpkgs";
inputs.nixpkgs.follows = "nixpkgs";
};
};
outputs = { self, nixpkgs, fenix, sydpkgs, ... }:
let
supportedSystems = [
"aarch64-darwin" "aarch64-linux"
"x86_64-darwin" "x86_64-linux"
];
each-system = f: nixpkgs.lib.genAttrs supportedSystems (system: f rec {
pkgs = import nixpkgs {
inherit system overlays;
};
inherit (pkgs) lib;
inherit system;
});
overlays = [
(final: prev: {
inherit (sydpkgs.packages.${final.stdenv.hostPlatform.system})
bdwgc;
})
fenix.overlays.default
];
in {
_pkgs = each-system ({ pkgs, ... }: pkgs);
packages = each-system ({ pkgs, ... }: {
default = pkgs.callPackage ./. {};
});
devShells = each-system ({ pkgs, lib, ... }: {
default = pkgs.mkShell {
RUSTFLAGS = "-L " + lib.makeLibraryPath [
pkgs.bdwgc
];
packages = [
pkgs.pkg-config
pkgs.bdwgc
(pkgs.fenix.complete.withComponents [
"cargo" "clippy" "rust-src" "rustc" "rustfmt"
])
pkgs.rust-analyzer-nightly
pkgs.cmake
];
};
});
};
nixConfig = {
extra-substituters = [
"https://fenix.cachix.org"
];
extra-trusted-public-keys = [
"fenix.cachix.org-1:ecJhr+RdYEdcVgUkjruiYhjbBloIEGov7bos90cZi0Q="
];
};
}

View File

@@ -1,75 +0,0 @@
#include <stdio.h>
#include <gc.h>
#include "gyehoek.h"
const long scm_tc3_cons = 0;
const long scm_tc7_obarray = 0x55;
const long scm_tc7_symbol = 0x05;
const long scm_tc7_string = 0x15;
SCM scm_newline () {
putc ('\n', stdout);
return SCM_PACK(NULL);
}
static void scm_write_string (SCM x) {
const size_t len = SCM_CELL_WORD (x, 1);
const char *s = (const char *) SCM_UNPACK_POINTER (SCM_CELL_OBJECT (x, 2));
/* FIXME: this is a very naïve implementation with no escaping. */
printf ("some unrelated unicode lol: %s\n", "왜 하냐??");
printf ("\"%.*s\"", (int) len, s);
}
SCM scm_write (SCM x) {
if (SCM_IMP (x)) {
printf ("%ld", SCM_UNPACK (x) >> 2);
} else if (SCM_CONSP (x)) {
printf ("(");
scm_write (scm_car (x));
printf (" . ");
scm_write (scm_cdr (x));
printf (")");
} else if (SCM_STRINGP (x)) {
scm_write_string (x);
} else {
printf ("#<heap object 0x%016lx>", SCM_UNPACK (x));
}
return SCM_PACK(NULL);
}
SCM scm_car (SCM x) {
return SCM_CELL_OBJECT (x, 0);
}
SCM scm_cdr (SCM x) {
return SCM_CELL_OBJECT (x, 1);
}
SCM scm_words (scm_t_bits word_0, uint32_t n_words) {
scm_t_bits *r = GC_malloc (n_words * sizeof (scm_t_bits));
r[0] = word_0;
return SCM_PACK (r);
}
SCM scm_from_utf8_string (const char *str, size_t len) {
SCM r = scm_words (scm_tc7_string, 3);
SCM_SET_CELL_WORD (r, 1, len);
SCM_SET_CELL_WORD (r, 2, str);
printf ("str: %p\n", str);
return r;
}
SCM scm_from_utf8_symbol (const char *s, size_t len) {
}
SCM scm_cons (SCM car, SCM cdr) {
scm_t_bits *r = GC_malloc (2 * sizeof (scm_t_bits));
r[0] = SCM_UNPACK (car);
r[1] = SCM_UNPACK (cdr);
return SCM_PACK (r);
}

View File

@@ -1,102 +0,0 @@
#ifndef GYEHOEK_H
#define GYEHOEK_H
#include <stddef.h>
#include <stdint.h>
typedef uintptr_t scm_t_bits;
typedef union SCM { struct { scm_t_bits n; } n; } SCM;
#define SCM_UNPACK(x) ((x).n.n)
#define SCM_PACK(x) ((SCM) { { (scm_t_bits) (x) } })
#define SCM_IMP(x) (6 & SCM_UNPACK (x))
#define SCM_NIMP(x) (!SCM_IMP (x))
#define SCM_HEAP_OBJECT_P(x) (SCM_NIMP (x))
#define SCM_UNPACK_POINTER(x) ((scm_t_bits *) (SCM_UNPACK (x)))
#define SCM_PACK_POINTER(x) (SCM_PACK ((scm_t_bits) (x)))
#define SCM_FALSE 0b00100
#define SCM_TRUE 0b01100
#define SCM_EOL 0b10100
#if (-1 >> 2 == -1) && (-4 >> 2 == -1) && (-5 >> 2 == -2) && (-8 >> 2 == -2)
# define SCM_SRS(x, y) ((x) >> (y))
#else
# define SCM_SRS(x, y) \
((x) < 0 \
? -1 - (scm_t_signed_bits) (~(scm_t_bits)(x) >> (y)) \
: ((x) >> (y)))
#endif
#define SCM_MAKE_SMALL_INT(x) (SCM_SRS ((SCM_PACK (x)), 2) + 2)
#define SCM_GET_SMALL_INT(x) (SCM_UNPACK (x) >> 2)
/* Checking if a SCM variable holds a pair (for historical reasons, in
Guile also known as a cons-cell): This is done by first checking that
the SCM variable holds a heap object, and second, by checking that
tc1==0 holds for the SCM_CELL_TYPE of the SCM variable. */
#define SCM_CONSP(x) (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
#define scm_tc2_int 2
#define SCM_ITAG3(x) (7 & SCM_UNPACK (x))
#define SCM_TYP3(x) (7 & SCM_CELL_TYPE (x))
/* #define scm_tc3_cons 0 */
extern const long scm_tc3_cons;
SCM scm_cons (SCM car, SCM cdr);
SCM scm_car (SCM x);
SCM scm_cdr (SCM x);
#define SCM_UNPACK_POINTER(x) ((scm_t_bits *) (SCM_UNPACK (x)))
#define SCM_PACK_POINTER(x) (SCM_PACK ((scm_t_bits) (x)))
#define SCM_CELL_OBJECT(x, n) (((SCM *)SCM_UNPACK_POINTER (x)) [n])
#define SCM_CELL_WORD(x, n) (SCM_UNPACK (SCM_CELL_OBJECT ((x), (n))))
#define SCM_SET_CELL_OBJECT(x, n, v) \
((((SCM *)SCM_UNPACK_POINTER (x)) [n]) = (v))
#define SCM_SET_CELL_WORD(x, n, v) \
(SCM_SET_CELL_OBJECT ((x), (n), SCM_PACK (v)))
#define SCM_CELL_TYPE(x) SCM_CELL_WORD (x, 0)
#define SCM_TYP7(x) (0x7f & SCM_CELL_TYPE (x))
#define SCM_HAS_HEAP_TYPE(x, type, tag) \
(SCM_NIMP (x) && type (x) == (tag))
#define SCM_HAS_TYP7(x, tag) (SCM_HAS_HEAP_TYPE (x, SCM_TYP7, tag))
extern const long scm_tc7_obarray;
extern const long scm_tc7_symbol;
extern const long scm_tc7_string;
#define SCM_STRINGP(x) (SCM_TYP7 (x) == scm_tc7_string)
SCM scm_words (scm_t_bits word_0, uint32_t n_words);
/* Construct a Scheme string. */
SCM scm_from_utf8_string (const char *str, size_t len);
/* Intern a symbol with a UTF-8 string name. */
SCM scm_from_utf8_symbol (const char *s, size_t len);
SCM scm_write (SCM);
#endif /* GYEHOEK_H */

View File

@@ -1,24 +0,0 @@
#include "gyehoek.h"
#include "obarray.h"
typedef struct {
unsigned long hash;
scm_t_bits key;
} scm_t_weak_entry;
struct weak_entry_data {
scm_t_weak_entry *in;
scm_t_weak_entry *out;
};
typedef struct {
scm_t_weak_entry *entries; /* the data */
scm_i_pthread_mutex_t lock; /* the lock */
unsigned long size; /* total number of slots. */
unsigned long n_items; /* number of items in set */
unsigned long lower; /* when to shrink */
unsigned long upper; /* when to grow */
int size_index; /* index into hashset_size */
int min_size_index; /* minimum size_index */
} scm_t_weak_set;

View File

@@ -1,8 +0,0 @@
#ifndef OBARRAY_H
#define OBARRAY_H
#define SCM_OBARRAY_P(x) (SCM_HAS_TYP7 (x, scm_tc7_weak_set))
SCM scm_obarray_insert ()
#endif /* OBARRAY_H */

109
runtime/src/lib.rs Normal file
View File

@@ -0,0 +1,109 @@
use std::{io::{stdout, Write}};
const scm_tc3_cons: u64 = 0;
const scm_tc2_int: u64 = 2;
type scm_bits = u64;
#[repr(C)]
#[derive(Clone, Copy)]
struct SCM {
n : scm_bits
}
fn scm_pack (bits : scm_bits) -> SCM {
SCM {n: bits}
}
fn scm_unpack (x : SCM) -> scm_bits {
x.n
}
fn scm_unpack_pointer (x : SCM) -> *mut scm_bits {
x.n as *mut scm_bits
}
fn scm_pack_pointer (x : *const scm_bits) -> SCM {
SCM {n: x as scm_bits}
}
fn scm_cell_object (x: SCM, n: usize) -> SCM {
let p = scm_unpack_pointer (x) as *mut SCM;
unsafe {
*(p.wrapping_add (n))
}
}
fn scm_cell_word (x: SCM, n: usize) -> scm_bits {
scm_unpack (scm_cell_object (x, n))
}
fn is_immediate (x: SCM) -> bool {
6 & scm_unpack (x) != 0
}
fn scm_cell_type (x: SCM) -> scm_bits {
scm_cell_word (x, 0)
}
fn is_cons (x: SCM) -> bool {
! is_immediate (x) && (1 & scm_cell_type (x)) == 0
}
fn is_small_int (x: SCM) -> bool {
3 & scm_unpack (x) == scm_tc2_int
}
fn get_small_int (x: SCM) -> scm_bits {
scm_unpack (x) >> 2
}
fn scm_car (x: SCM) -> SCM {
scm_cell_object (x, 0)
}
fn scm_cdr (x: SCM) -> SCM {
scm_cell_object (x, 1)
}
#[unsafe(no_mangle)]
pub extern "C" fn scm_write (x: SCM) -> SCM {
if is_small_int (x) {
print! ("{:?}", get_small_int (x));
} else if is_cons (x) {
print! ("(");
scm_write (scm_car (x));
print! (" . ");
scm_write (scm_cdr (x));
print! (")");
} else {
let ty = if is_immediate (x) { "immediate" } else { "heap object" };
print! ("#<{ty} {:#016x}>", scm_unpack (x));
}
stdout ().flush ();
return scm_pack (0);
}
#[unsafe(no_mangle)]
pub extern "C" fn scm_from_utf8_string (s: scm_bits, len: scm_bits) -> scm_bits {
println! ("scm_from_utf8_string");
return 0;
}
pub fn add (left: u64, right: u64) -> u64 {
left + right
}
#[cfg(test)]
mod tests {
use super::*;
#[test]
fn it_works () {
let result = add (2, 2);
assert_eq! (result, 4);
}
}