SCM sum type

play/.gitignore

@@ -0,0 +1,4 @@
+*.anf
+*.s
+*.ssa
+*.out

play/a.c

@@ -1,21 +0,0 @@
-#include <stdio.h>
-#include <libguile/scm.h>
-
-#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
-
-int main () {
-  unsigned long mask = 0xfffffffffffffffe;
-  unsigned long x = (4 << 2) + 2;
-  unsigned long y = (2 << 2) + 2;
-  unsigned long z = ((x + y) >> 2) + 2;
-  printf ("BLAH: %d\n", BLAH);
-  printf ("%ld\n", sizeof(long));
-  printf ("%lx\n", (long) z >> 2);
-}

play/hash.c

@@ -1,48 +0,0 @@
-#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)));
-}

play/string.anf

@@ -1,4 +0,0 @@
-;;; -*- mode:scheme -*-
-
-(let ((x0 (prim:write "abc"))) x0)
-

play/string.s

@@ -1,23 +0,0 @@
-.data
-.balign 8
-.1:
-	.ascii "abc"
-/* end data */
-
-.text
-.globl main
-main:
-	pushq %rbp
-	movq %rsp, %rbp
-	movl $3, %esi
-	leaq .1(%rip), %rdi
-	callq scm_from_utf8_string
-	movq %rax, %rdi
-	callq scm_write
-	leave
-	ret
-.type main, @function
-.size main, .-main
-/* end function main */
-
-.section .note.GNU-stack,"",@progbits

play/string.ssa

@@ -1,10 +0,0 @@
-
-data $.1 =
-{b "abc"}
-export
-function w $main () {
-@start
-    %.2 =l call $scm_from_utf8_string (l $.1, l 3)
-    %x0 =l call $scm_write (l %.2)
-    ret %x0
-}

play/t.anf

@@ -1,4 +0,0 @@
-;;; -*- mode:scheme -*-
-
-(let ((x0 (prim:cons 4 2)) (x1 (prim:write x0))) x1)
-

play/t.s

@@ -1,18 +0,0 @@
-.text
-.globl main
-main:
-	pushq %rbp
-	movq %rsp, %rbp
-	movl $16, %edi
-	callq GC_malloc
-	movq %rax, %rdi
-	movq $18, (%rdi)
-	movq $10, 8(%rdi)
-	callq scm_write
-	leave
-	ret
-.type main, @function
-.size main, .-main
-/* end function main */
-
-.section .note.GNU-stack,"",@progbits

play/t.ssa

@@ -1,10 +0,0 @@
-export
-function w $main () {
-@start
-    %x0 =l call $GC_malloc (l 16)
-    %.2 =l add %x0, 8
-    storel 18, %x0
-    storel 10, %.2
-    %x1 =l call $scm_write (l %x0)
-    ret %x1
-}

play/wtf.s

@@ -1,31 +0,0 @@
-.data
-.balign 8
-fstr:
-	.ascii "%s"
-	.byte 0
-/* end data */
-
-.data
-.balign 8
-str:
-	.ascii "안녕하세요"
-	.byte 0
-/* end data */
-
-.text
-.globl main
-main:
-	pushq %rbp
-	movq %rsp, %rbp
-	leaq str(%rip), %rsi
-	leaq fstr(%rip), %rdi
-	movl $0, %eax
-	callq printf
-	movl $0, %eax
-	leave
-	ret
-.type main, @function
-.size main, .-main
-/* end function main */
-
-.section .note.GNU-stack,"",@progbits

play/wtf.ssa

@@ -1,8 +0,0 @@
-data $fstr = { b "%s", b 0 }
-data $str = { b "안녕하세요", b 0 }
-
-export function w $main () {
-@start
-	call $printf (l $fstr, ..., l $str)
-	ret 0
-}