mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-19 05:39:17 +02:00
Added example code
This commit is contained in:
Justin Ethier
parent
e63ac0aeb1
commit
7d3b553a2c
5 changed files with 3157 additions and 584 deletions
2894
examples/hello-library/int-test/base.c
Normal file
2894
examples/hello-library/int-test/base.c
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -6,223 +6,6 @@
|
|||
**
|
||||
**/
|
||||
|
||||
/*
|
||||
"---------------- input program:"
|
||||
*/
|
||||
/*
|
||||
((define lib2-hello "Hello from library #2") (write lib2-hello))
|
||||
*/
|
||||
/*
|
||||
"---------------- after macro expansion:"
|
||||
*/
|
||||
/*
|
||||
((define *Cyc-version-banner*
|
||||
"\n :@ \n @@@ \n @@@@: \n `@@@@@+ \n .@@@+@@@ Cyclone \n @@ @@ An experimental Scheme compiler\n ,@ https://github.com/justinethier/cyclone\n '@ \n .@ \n @@ #@ (c) 2014 Justin Ethier\n `@@@#@@@. Version 0.0.1 (Pre-release)\n #@@@@@ \n +@@@+ \n @@# \n `@. \n \n")
|
||||
(define call-with-current-continuation call/cc)
|
||||
(define Cyc-bin-op
|
||||
(lambda (cmp x lst)
|
||||
(if (null? lst)
|
||||
#t
|
||||
(if (cmp x (car lst)) (Cyc-bin-op cmp (car lst) (cdr lst)) #f))))
|
||||
(define Cyc-bin-op-char
|
||||
(lambda (cmp c cs)
|
||||
(Cyc-bin-op
|
||||
(lambda (x y) (cmp (char->integer x) (char->integer y)))
|
||||
c
|
||||
cs)))
|
||||
(define char=? (lambda (c1 c2 . cs) (Cyc-bin-op-char = c1 (cons c2 cs))))
|
||||
(define char<? (lambda (c1 c2 . cs) (Cyc-bin-op-char < c1 (cons c2 cs))))
|
||||
(define char>? (lambda (c1 c2 . cs) (Cyc-bin-op-char > c1 (cons c2 cs))))
|
||||
(define char<=? (lambda (c1 c2 . cs) (Cyc-bin-op-char <= c1 (cons c2 cs))))
|
||||
(define char>=? (lambda (c1 c2 . cs) (Cyc-bin-op-char >= c1 (cons c2 cs))))
|
||||
(define char-upcase
|
||||
(lambda (c)
|
||||
(if (char-lower-case? c)
|
||||
(integer->char
|
||||
(- (char->integer c) (- (char->integer #\a) (char->integer #\A))))
|
||||
c)))
|
||||
(define char-downcase
|
||||
(lambda (c)
|
||||
(if (char-upper-case? c)
|
||||
(integer->char
|
||||
(+ (char->integer c) (- (char->integer #\a) (char->integer #\A))))
|
||||
c)))
|
||||
(define char-alphabetic? (lambda (c) (if (char>=? c #\A) (char<=? c #\z) #f)))
|
||||
(define char-upper-case? (lambda (c) (if (char>=? c #\A) (char<=? c #\Z) #f)))
|
||||
(define char-lower-case? (lambda (c) (if (char>=? c #\a) (char<=? c #\z) #f)))
|
||||
(define char-numeric?
|
||||
(lambda (c) (member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))))
|
||||
(define char-whitespace?
|
||||
(lambda (c) (member c '(#\tab #\space #\return #\newline))))
|
||||
(define digit-value
|
||||
(lambda (c)
|
||||
(if (char-numeric? c) (- (char->integer c) (char->integer #\0)) #f)))
|
||||
(define foldl
|
||||
(lambda (func accum lst)
|
||||
(if (null? lst) accum (foldl func (func (car lst) accum) (cdr lst)))))
|
||||
(define foldr
|
||||
(lambda (func end lst)
|
||||
(if (null? lst) end (func (car lst) (foldr func end (cdr lst))))))
|
||||
(define not (lambda (x) (if x #f #t)))
|
||||
(define list?
|
||||
(lambda (o)
|
||||
(define _list?
|
||||
(lambda (obj)
|
||||
(if (null? obj) #t (if (pair? obj) (_list? (cdr obj)) #f))))
|
||||
(if (Cyc-has-cycle? o) #t (_list? o))))
|
||||
(define zero? (lambda (n) (= n 0)))
|
||||
(define positive? (lambda (n) (> n 0)))
|
||||
(define negative? (lambda (n) (< n 0)))
|
||||
(define append
|
||||
(lambda lst
|
||||
(define append-2
|
||||
(lambda (inlist alist)
|
||||
(foldr (lambda (ap in) (cons ap in)) alist inlist)))
|
||||
(if (null? lst)
|
||||
lst
|
||||
(if (null? (cdr lst))
|
||||
(car lst)
|
||||
(foldl (lambda (a b) (append-2 b a)) (car lst) (cdr lst))))))
|
||||
(define list (lambda objs objs))
|
||||
(define make-list
|
||||
(lambda (k . fill)
|
||||
((lambda (x make)
|
||||
((lambda ()
|
||||
(set! x (if (null? fill) #f (car fill)))
|
||||
(set! make
|
||||
(lambda (n obj) (if (zero? n) '() (cons obj (make (- n 1) obj)))))
|
||||
(make k x))))
|
||||
#f
|
||||
#f)))
|
||||
(define list-copy (lambda (lst) (foldr (lambda (x y) (cons x y)) '() lst)))
|
||||
(define map
|
||||
(lambda (func lst) (foldr (lambda (x y) (cons (func x) y)) '() lst)))
|
||||
(define for-each
|
||||
(lambda (f lst)
|
||||
(if (null? lst) #t ((lambda () (f (car lst)) (for-each f (cdr lst)))))))
|
||||
(define list-tail
|
||||
(lambda (lst k) (if (zero? k) lst (list-tail (cdr lst) (- k 1)))))
|
||||
(define list-ref (lambda (lst k) (car (list-tail lst k))))
|
||||
(define list-set!
|
||||
(lambda (lst k obj) ((lambda (kth) (set-car! kth obj)) (list-tail lst k))))
|
||||
(define reverse (lambda (lst) (foldl cons '() lst)))
|
||||
(define boolean=? (lambda (b1 b2 . bs) (Cyc-obj=? boolean? b1 (cons b2 bs))))
|
||||
(define symbol=?
|
||||
(lambda (sym1 sym2 . syms) (Cyc-obj=? symbol? sym1 (cons sym2 syms))))
|
||||
(define Cyc-obj=?
|
||||
(lambda (type? obj objs)
|
||||
(if (type? obj)
|
||||
(call/cc
|
||||
(lambda (return)
|
||||
(for-each (lambda (o) (if (not (eq? o obj)) (return #f) #f)) objs)
|
||||
#t))
|
||||
#f)))
|
||||
(define make-string
|
||||
(lambda (k . fill)
|
||||
((lambda (fill*) (list->string (apply make-list (cons k fill*))))
|
||||
(if (null? fill) '(#\space) fill))))
|
||||
(define error (lambda (msg . args) (raise (cons msg args))))
|
||||
(define raise
|
||||
(lambda (obj) ((Cyc-current-exception-handler) (list 'raised obj))))
|
||||
(define raise-continuable
|
||||
(lambda (obj) ((Cyc-current-exception-handler) (list 'continuable obj))))
|
||||
(define with-exception-handler
|
||||
(lambda (handler thunk)
|
||||
((lambda (result my-handler)
|
||||
(Cyc-add-exception-handler my-handler)
|
||||
(set! result (thunk))
|
||||
(Cyc-remove-exception-handler)
|
||||
result)
|
||||
#f
|
||||
(lambda (obj)
|
||||
((lambda (result continuable?)
|
||||
(Cyc-remove-exception-handler)
|
||||
(set! result (handler (cadr obj)))
|
||||
(if continuable? result (error "exception handler returned")))
|
||||
#f
|
||||
(if (pair? obj) (equal? (car obj) 'continuable) #f))))))
|
||||
(define *exception-handler-stack* '())
|
||||
(define Cyc-add-exception-handler
|
||||
(lambda (h)
|
||||
(set! *exception-handler-stack* (cons h *exception-handler-stack*))))
|
||||
(define Cyc-remove-exception-handler
|
||||
(lambda ()
|
||||
(if (not (null? *exception-handler-stack*))
|
||||
(set! *exception-handler-stack* (cdr *exception-handler-stack*))
|
||||
#f)))
|
||||
(define lib2-hello "Hello from library #2")
|
||||
(write lib2-hello))
|
||||
*/
|
||||
/*
|
||||
"---------------- after processing globals"
|
||||
*/
|
||||
/*
|
||||
((define *exception-handler-stack* #f)
|
||||
(define lib2-hello "Hello from library #2")
|
||||
((lambda () (set! *exception-handler-stack* '()) (write lib2-hello))))
|
||||
*/
|
||||
/*
|
||||
"---------------- after alpha conversion:"
|
||||
*/
|
||||
/*
|
||||
((define *exception-handler-stack* #f)
|
||||
(define lib2-hello "Hello from library #2")
|
||||
((lambda () (set! *exception-handler-stack* '()) (write lib2-hello))))
|
||||
*/
|
||||
/*
|
||||
"---------------- after CPS:"
|
||||
*/
|
||||
/*
|
||||
((define call/cc (lambda (k f) (f k (lambda (_ result) (k result)))))
|
||||
(define *exception-handler-stack* #f)
|
||||
(define lib2-hello "Hello from library #2")
|
||||
((lambda ()
|
||||
((lambda (r$6)
|
||||
((lambda (r$5) (%halt (write lib2-hello)))
|
||||
(set! *exception-handler-stack* r$6)))
|
||||
'()))))
|
||||
*/
|
||||
/*
|
||||
"---------------- after wrap-mutables:"
|
||||
*/
|
||||
/*
|
||||
((define call/cc (lambda (k f) (f k (lambda (_ result) (k result)))))
|
||||
(define *exception-handler-stack* #f)
|
||||
(define lib2-hello "Hello from library #2")
|
||||
((lambda ()
|
||||
((lambda (r$6)
|
||||
((lambda (r$5) (%halt (write lib2-hello)))
|
||||
(set-global! *exception-handler-stack* r$6)))
|
||||
'()))))
|
||||
*/
|
||||
/*
|
||||
"---------------- after closure-convert:"
|
||||
*/
|
||||
/*
|
||||
((define call/cc
|
||||
(lambda (k f)
|
||||
((%closure-ref f 0)
|
||||
f
|
||||
k
|
||||
(%closure
|
||||
(lambda (self$7 _ result)
|
||||
((%closure-ref (%closure-ref self$7 1) 0)
|
||||
(%closure-ref self$7 1)
|
||||
result))
|
||||
k))))
|
||||
(define *exception-handler-stack* (%closure-ref #f 0) #f)
|
||||
(define lib2-hello
|
||||
(%closure-ref "Hello from library #2" 0)
|
||||
"Hello from library #2")
|
||||
((lambda ()
|
||||
((lambda (r$6)
|
||||
((lambda (r$5) (%halt (write lib2-hello)))
|
||||
(set-global! *exception-handler-stack* r$6)))
|
||||
'()))))
|
||||
*/
|
||||
/*
|
||||
"---------------- C code:"
|
||||
*/
|
||||
#define funcall0(cfn) ((cfn)->fn)(0,cfn)
|
||||
/* Return to continuation after checking for stack overflow. */
|
||||
#define return_funcall0(cfn) \
|
||||
|
|
@ -278,71 +61,85 @@
|
|||
} else { (_fn)(2,(closure)_fn,a1,a2); }}
|
||||
|
||||
#include "cyclone.h"
|
||||
extern object __glo_lib2_91hello;
|
||||
//object __glo_lib2_91hello = nil;
|
||||
object __glo__85exception_91handler_91stack_85 = nil;
|
||||
object __glo_call_95cc = nil;
|
||||
|
||||
|
||||
extern object __glo__85Cyc_91version_91banner_85;
|
||||
extern object __glo_call_91with_91current_91continuation;
|
||||
extern object __glo_call_95cc;
|
||||
extern object __glo_char_123_127;
|
||||
extern object __glo_char_121_127;
|
||||
extern object __glo_char_125_127;
|
||||
extern object __glo_char_121_123_127;
|
||||
extern object __glo_char_125_123_127;
|
||||
extern object __glo_char_91upcase;
|
||||
extern object __glo_char_91downcase;
|
||||
extern object __glo_char_91alphabetic_127;
|
||||
extern object __glo_char_91upper_91case_127;
|
||||
extern object __glo_char_91lower_91case_127;
|
||||
extern object __glo_char_91numeric_127;
|
||||
extern object __glo_char_91whitespace_127;
|
||||
extern object __glo_digit_91value;
|
||||
extern object __glo_foldl;
|
||||
extern object __glo_foldr;
|
||||
extern object __glo_not;
|
||||
extern object __glo_list_127;
|
||||
extern object __glo_zero_127;
|
||||
extern object __glo_positive_127;
|
||||
extern object __glo_negative_127;
|
||||
extern object __glo_append;
|
||||
extern object __glo__list;
|
||||
extern object __glo_make_91list;
|
||||
extern object __glo_list_91copy;
|
||||
extern object __glo_map;
|
||||
extern object __glo_for_91each;
|
||||
extern object __glo_list_91tail;
|
||||
extern object __glo_list_91ref;
|
||||
extern object __glo_list_91set_67;
|
||||
extern object __glo_reverse;
|
||||
extern object __glo_boolean_123_127;
|
||||
extern object __glo_symbol_123_127;
|
||||
extern object __glo_Cyc_91obj_123_127;
|
||||
extern object __glo_make_91string;
|
||||
extern object __glo_error;
|
||||
extern object __glo_raise;
|
||||
extern object __glo_raise_91continuable;
|
||||
extern object __glo_with_91exception_91handler;
|
||||
extern object __glo__85exception_91handler_91stack_85;
|
||||
extern object __glo_Cyc_91add_91exception_91handler;
|
||||
extern object __glo_Cyc_91remove_91exception_91handler;
|
||||
extern object __glo_lib1_91hello;
|
||||
extern object __glo_lib1_91test;
|
||||
#include "runtime.h"
|
||||
#include "runtime-main.h"
|
||||
static void __lambda_4(int argc, closure _) ;
|
||||
static void __lambda_3(int argc, closure _,object r_736) ;
|
||||
static void __lambda_2(int argc, closure _,object r_735) ;
|
||||
static void __lambda_1(int argc, closure _,object k, object f) ;
|
||||
static void __lambda_0(int argc, object self_737, object _191, object result) ;
|
||||
static void __lambda_3(int argc, closure _) ;
|
||||
static void __lambda_2(int argc, closure _,object r_731) ;
|
||||
static void __lambda_1(int argc, closure _,object r_732) ;
|
||||
static void __lambda_0(int argc, closure _,object r_733) ;
|
||||
|
||||
static void __lambda_4(int argc, closure _) {
|
||||
return_check1(__lambda_3,nil);;
|
||||
static void __lambda_3(int argc, closure _) {
|
||||
make_int(c_7318, 0);
|
||||
return_check1(__lambda_2,&c_7318);;
|
||||
}
|
||||
|
||||
static void __lambda_3(int argc, closure _,object r_736) {
|
||||
return_check1(__lambda_2,global_set(__glo__85exception_91handler_91stack_85, r_736));;
|
||||
static void __lambda_2(int argc, closure _,object r_731) {
|
||||
make_string(c_7317, "hello");
|
||||
return_check1(__lambda_1,Cyc_write(&c_7317));;
|
||||
}
|
||||
|
||||
static void __lambda_2(int argc, closure _,object r_735) {
|
||||
__halt(Cyc_write(__glo_lib2_91hello));
|
||||
static void __lambda_1(int argc, closure _,object r_732) {
|
||||
return_check1(__lambda_0,Cyc_write(__glo_lib1_91hello));;
|
||||
}
|
||||
|
||||
static void __lambda_1(int argc, closure _,object k, object f) {
|
||||
|
||||
closureN_type c_7310;
|
||||
c_7310.tag = closureN_tag;
|
||||
c_7310.fn = __lambda_0;
|
||||
c_7310.num_elt = 1;
|
||||
c_7310.elts = (object *)alloca(sizeof(object) * 1);
|
||||
c_7310.elts[0] = k;
|
||||
|
||||
return_funcall2( f, k, &c_7310);;
|
||||
static void __lambda_0(int argc, closure _,object r_733) {
|
||||
make_string(c_7312, "world");
|
||||
__halt(Cyc_write(&c_7312));
|
||||
}
|
||||
|
||||
static void __lambda_0(int argc, object self_737, object _191, object result) {
|
||||
return_funcall1( ((closureN)self_737)->elts[0], result);;
|
||||
}
|
||||
static void c_entry_pt(argc, env,cont) int argc; closure env,cont; {
|
||||
|
||||
c_schemebase_entry_pt(argc, env,cont);
|
||||
c_libslib1_entry_pt(argc, env, cont);
|
||||
c_libslib2_entry_pt(argc, env, cont);
|
||||
|
||||
static void c_entry_pt(argc, env,cont) int argc; closure env,cont; {
|
||||
|
||||
//add_global((object *) &__glo_lib2_91hello);
|
||||
add_global((object *) &__glo__85exception_91handler_91stack_85);
|
||||
add_global((object *) &__glo_call_95cc);
|
||||
mclosure0(c_738, (function_type)__lambda_1);
|
||||
__glo_call_95cc = &c_738;
|
||||
//make_string(c_7313, "Hello from library #2");
|
||||
//__glo_lib2_91hello = &c_7313;
|
||||
__glo__85exception_91handler_91stack_85 = boolean_f;
|
||||
|
||||
//make_cvar(cvar_7323, (object *)&__glo_lib2_91hello);make_cons(pair_7324, find_or_add_symbol("lib2-hello"), &cvar_7323);
|
||||
make_cvar(cvar_7325, (object *)&__glo__85exception_91handler_91stack_85);make_cons(pair_7326, find_or_add_symbol("*exception-handler-stack*"), &cvar_7325);
|
||||
make_cvar(cvar_7327, (object *)&__glo_call_95cc);make_cons(pair_7328, find_or_add_symbol("call/cc"), &cvar_7327);
|
||||
//make_cons(c_7331, &pair_7324,nil);
|
||||
make_cons(c_7330, &pair_7326, nil); //&c_7331);
|
||||
make_cons(c_7329, &pair_7328, &c_7330);
|
||||
Cyc_global_variables = &c_7329;
|
||||
|
||||
c_lib2_entry_pt(argc, env, cont);
|
||||
|
||||
return_check0(__lambda_4);
|
||||
return_check0(__lambda_3);
|
||||
}
|
||||
main(int argc,char **argv)
|
||||
{long stack_size = long_arg(argc,argv,"-s",STACK_SIZE);
|
||||
|
|
|
|||
|
|
@ -1,315 +0,0 @@
|
|||
/**
|
||||
** This file was automatically generated by the Cyclone scheme compiler
|
||||
**
|
||||
** (c) 2014 Justin Ethier
|
||||
** Version 0.0.1 (Pre-release)
|
||||
**
|
||||
**/
|
||||
|
||||
/*
|
||||
"---------------- input program:"
|
||||
*/
|
||||
/*
|
||||
((define-library
|
||||
(libs lib2)
|
||||
(export lib2-hello)
|
||||
(begin (define lib2-hello "Hello from library #2"))))
|
||||
*/
|
||||
/*
|
||||
"---------------- after macro expansion:"
|
||||
*/
|
||||
/*
|
||||
((define *Cyc-version-banner*
|
||||
"\n :@ \n @@@ \n @@@@: \n `@@@@@+ \n .@@@+@@@ Cyclone \n @@ @@ An experimental Scheme compiler\n ,@ https://github.com/justinethier/cyclone\n '@ \n .@ \n @@ #@ (c) 2014 Justin Ethier\n `@@@#@@@. Version 0.0.1 (Pre-release)\n #@@@@@ \n +@@@+ \n @@# \n `@. \n \n")
|
||||
(define call-with-current-continuation call/cc)
|
||||
(define Cyc-bin-op
|
||||
(lambda (cmp x lst)
|
||||
(if (null? lst)
|
||||
#t
|
||||
(if (cmp x (car lst)) (Cyc-bin-op cmp (car lst) (cdr lst)) #f))))
|
||||
(define Cyc-bin-op-char
|
||||
(lambda (cmp c cs)
|
||||
(Cyc-bin-op
|
||||
(lambda (x y) (cmp (char->integer x) (char->integer y)))
|
||||
c
|
||||
cs)))
|
||||
(define char=? (lambda (c1 c2 . cs) (Cyc-bin-op-char = c1 (cons c2 cs))))
|
||||
(define char<? (lambda (c1 c2 . cs) (Cyc-bin-op-char < c1 (cons c2 cs))))
|
||||
(define char>? (lambda (c1 c2 . cs) (Cyc-bin-op-char > c1 (cons c2 cs))))
|
||||
(define char<=? (lambda (c1 c2 . cs) (Cyc-bin-op-char <= c1 (cons c2 cs))))
|
||||
(define char>=? (lambda (c1 c2 . cs) (Cyc-bin-op-char >= c1 (cons c2 cs))))
|
||||
(define char-upcase
|
||||
(lambda (c)
|
||||
(if (char-lower-case? c)
|
||||
(integer->char
|
||||
(- (char->integer c) (- (char->integer #\a) (char->integer #\A))))
|
||||
c)))
|
||||
(define char-downcase
|
||||
(lambda (c)
|
||||
(if (char-upper-case? c)
|
||||
(integer->char
|
||||
(+ (char->integer c) (- (char->integer #\a) (char->integer #\A))))
|
||||
c)))
|
||||
(define char-alphabetic? (lambda (c) (if (char>=? c #\A) (char<=? c #\z) #f)))
|
||||
(define char-upper-case? (lambda (c) (if (char>=? c #\A) (char<=? c #\Z) #f)))
|
||||
(define char-lower-case? (lambda (c) (if (char>=? c #\a) (char<=? c #\z) #f)))
|
||||
(define char-numeric?
|
||||
(lambda (c) (member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))))
|
||||
(define char-whitespace?
|
||||
(lambda (c) (member c '(#\tab #\space #\return #\newline))))
|
||||
(define digit-value
|
||||
(lambda (c)
|
||||
(if (char-numeric? c) (- (char->integer c) (char->integer #\0)) #f)))
|
||||
(define foldl
|
||||
(lambda (func accum lst)
|
||||
(if (null? lst) accum (foldl func (func (car lst) accum) (cdr lst)))))
|
||||
(define foldr
|
||||
(lambda (func end lst)
|
||||
(if (null? lst) end (func (car lst) (foldr func end (cdr lst))))))
|
||||
(define not (lambda (x) (if x #f #t)))
|
||||
(define list?
|
||||
(lambda (o)
|
||||
(define _list?
|
||||
(lambda (obj)
|
||||
(if (null? obj) #t (if (pair? obj) (_list? (cdr obj)) #f))))
|
||||
(if (Cyc-has-cycle? o) #t (_list? o))))
|
||||
(define zero? (lambda (n) (= n 0)))
|
||||
(define positive? (lambda (n) (> n 0)))
|
||||
(define negative? (lambda (n) (< n 0)))
|
||||
(define append
|
||||
(lambda lst
|
||||
(define append-2
|
||||
(lambda (inlist alist)
|
||||
(foldr (lambda (ap in) (cons ap in)) alist inlist)))
|
||||
(if (null? lst)
|
||||
lst
|
||||
(if (null? (cdr lst))
|
||||
(car lst)
|
||||
(foldl (lambda (a b) (append-2 b a)) (car lst) (cdr lst))))))
|
||||
(define list (lambda objs objs))
|
||||
(define make-list
|
||||
(lambda (k . fill)
|
||||
((lambda (x make)
|
||||
((lambda ()
|
||||
(set! x (if (null? fill) #f (car fill)))
|
||||
(set! make
|
||||
(lambda (n obj) (if (zero? n) '() (cons obj (make (- n 1) obj)))))
|
||||
(make k x))))
|
||||
#f
|
||||
#f)))
|
||||
(define list-copy (lambda (lst) (foldr (lambda (x y) (cons x y)) '() lst)))
|
||||
(define map
|
||||
(lambda (func lst) (foldr (lambda (x y) (cons (func x) y)) '() lst)))
|
||||
(define for-each
|
||||
(lambda (f lst)
|
||||
(if (null? lst) #t ((lambda () (f (car lst)) (for-each f (cdr lst)))))))
|
||||
(define list-tail
|
||||
(lambda (lst k) (if (zero? k) lst (list-tail (cdr lst) (- k 1)))))
|
||||
(define list-ref (lambda (lst k) (car (list-tail lst k))))
|
||||
(define list-set!
|
||||
(lambda (lst k obj) ((lambda (kth) (set-car! kth obj)) (list-tail lst k))))
|
||||
(define reverse (lambda (lst) (foldl cons '() lst)))
|
||||
(define boolean=? (lambda (b1 b2 . bs) (Cyc-obj=? boolean? b1 (cons b2 bs))))
|
||||
(define symbol=?
|
||||
(lambda (sym1 sym2 . syms) (Cyc-obj=? symbol? sym1 (cons sym2 syms))))
|
||||
(define Cyc-obj=?
|
||||
(lambda (type? obj objs)
|
||||
(if (type? obj)
|
||||
(call/cc
|
||||
(lambda (return)
|
||||
(for-each (lambda (o) (if (not (eq? o obj)) (return #f) #f)) objs)
|
||||
#t))
|
||||
#f)))
|
||||
(define make-string
|
||||
(lambda (k . fill)
|
||||
((lambda (fill*) (list->string (apply make-list (cons k fill*))))
|
||||
(if (null? fill) '(#\space) fill))))
|
||||
(define error (lambda (msg . args) (raise (cons msg args))))
|
||||
(define raise
|
||||
(lambda (obj) ((Cyc-current-exception-handler) (list 'raised obj))))
|
||||
(define raise-continuable
|
||||
(lambda (obj) ((Cyc-current-exception-handler) (list 'continuable obj))))
|
||||
(define with-exception-handler
|
||||
(lambda (handler thunk)
|
||||
((lambda (result my-handler)
|
||||
(Cyc-add-exception-handler my-handler)
|
||||
(set! result (thunk))
|
||||
(Cyc-remove-exception-handler)
|
||||
result)
|
||||
#f
|
||||
(lambda (obj)
|
||||
((lambda (result continuable?)
|
||||
(Cyc-remove-exception-handler)
|
||||
(set! result (handler (cadr obj)))
|
||||
(if continuable? result (error "exception handler returned")))
|
||||
#f
|
||||
(if (pair? obj) (equal? (car obj) 'continuable) #f))))))
|
||||
(define *exception-handler-stack* '())
|
||||
(define Cyc-add-exception-handler
|
||||
(lambda (h)
|
||||
(set! *exception-handler-stack* (cons h *exception-handler-stack*))))
|
||||
(define Cyc-remove-exception-handler
|
||||
(lambda ()
|
||||
(if (not (null? *exception-handler-stack*))
|
||||
(set! *exception-handler-stack* (cdr *exception-handler-stack*))
|
||||
#f)))
|
||||
(define lib2-hello "Hello from library #2"))
|
||||
*/
|
||||
/*
|
||||
"---------------- after processing globals"
|
||||
*/
|
||||
/*
|
||||
((define *exception-handler-stack* #f)
|
||||
(define lib2-hello "Hello from library #2")
|
||||
(set! *exception-handler-stack* '()))
|
||||
*/
|
||||
/*
|
||||
"---------------- after alpha conversion:"
|
||||
*/
|
||||
/*
|
||||
((define *exception-handler-stack* #f)
|
||||
(define lib2-hello "Hello from library #2")
|
||||
(set! *exception-handler-stack* '()))
|
||||
*/
|
||||
/*
|
||||
"---------------- after CPS:"
|
||||
*/
|
||||
/*
|
||||
((define call/cc (lambda (k f) (f k (lambda (_ result) (k result)))))
|
||||
(define *exception-handler-stack* #f)
|
||||
(define lib2-hello "Hello from library #2")
|
||||
((lambda (r$5) (%halt (set! *exception-handler-stack* r$5))) '()))
|
||||
*/
|
||||
/*
|
||||
"---------------- after wrap-mutables:"
|
||||
*/
|
||||
/*
|
||||
((define call/cc (lambda (k f) (f k (lambda (_ result) (k result)))))
|
||||
(define *exception-handler-stack* #f)
|
||||
(define lib2-hello "Hello from library #2")
|
||||
((lambda (r$5) (%halt (set-global! *exception-handler-stack* r$5))) '()))
|
||||
*/
|
||||
/*
|
||||
"---------------- after closure-convert:"
|
||||
*/
|
||||
/*
|
||||
((define call/cc
|
||||
(lambda (k f)
|
||||
((%closure-ref f 0)
|
||||
f
|
||||
k
|
||||
(%closure
|
||||
(lambda (self$6 _ result)
|
||||
((%closure-ref (%closure-ref self$6 1) 0)
|
||||
(%closure-ref self$6 1)
|
||||
result))
|
||||
k))))
|
||||
(define *exception-handler-stack* (%closure-ref #f 0) #f)
|
||||
(define lib2-hello
|
||||
(%closure-ref "Hello from library #2" 0)
|
||||
"Hello from library #2")
|
||||
((lambda (r$5) (%halt (set-global! *exception-handler-stack* r$5))) '()))
|
||||
*/
|
||||
/*
|
||||
"---------------- C code:"
|
||||
*/
|
||||
|
||||
#define funcall1(cfn,a1) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(0, (closure)a1, cfn); } else { ((cfn)->fn)(1,cfn,a1);}
|
||||
/* Return to continuation after checking for stack overflow. */
|
||||
#define return_funcall1(cfn,a1) \
|
||||
{char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[1]; buf[0] = a1;\
|
||||
GC(cfn,buf,1); return; \
|
||||
} else {funcall1((closure) (cfn),a1); return;}}
|
||||
|
||||
/* Evaluate an expression after checking for stack overflow. */
|
||||
#define return_check1(_fn,a1) { \
|
||||
char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[1]; buf[0] = a1; \
|
||||
mclosure0(c1, _fn); \
|
||||
GC(&c1, buf, 1); return; \
|
||||
} else { (_fn)(1,(closure)_fn,a1); }}
|
||||
|
||||
#define funcall2(cfn,a1,a2) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(1, (closure)a1, cfn,a2); } else { ((cfn)->fn)(2,cfn,a1,a2);}
|
||||
/* Return to continuation after checking for stack overflow. */
|
||||
#define return_funcall2(cfn,a1,a2) \
|
||||
{char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[2]; buf[0] = a1;buf[1] = a2;\
|
||||
GC(cfn,buf,2); return; \
|
||||
} else {funcall2((closure) (cfn),a1,a2); return;}}
|
||||
|
||||
/* Evaluate an expression after checking for stack overflow. */
|
||||
#define return_check2(_fn,a1,a2) { \
|
||||
char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[2]; buf[0] = a1;buf[1] = a2; \
|
||||
mclosure0(c1, _fn); \
|
||||
GC(&c1, buf, 2); return; \
|
||||
} else { (_fn)(2,(closure)_fn,a1,a2); }}
|
||||
|
||||
#include "cyclone.h"
|
||||
|
||||
object __glo_lib2_91hello = nil;
|
||||
|
||||
#include "runtime.h"
|
||||
|
||||
static void __lambda_2(int argc, closure _,object r_735) ;
|
||||
static void __lambda_1(int argc, closure _,object k, object f) ;
|
||||
static void __lambda_0(int argc, object self_736, object _191, object result) ;
|
||||
|
||||
static void __lambda_2(int argc, closure _,object r_735) {
|
||||
__halt(global_set(__glo__85exception_91handler_91stack_85, r_735));
|
||||
}
|
||||
|
||||
static void __lambda_1(int argc, closure _,object k, object f) {
|
||||
|
||||
closureN_type c_739;
|
||||
c_739.tag = closureN_tag;
|
||||
c_739.fn = __lambda_0;
|
||||
c_739.num_elt = 1;
|
||||
c_739.elts = (object *)alloca(sizeof(object) * 1);
|
||||
c_739.elts[0] = k;
|
||||
|
||||
return_funcall2( f, k, &c_739);;
|
||||
}
|
||||
|
||||
static void __lambda_0(int argc, object self_736, object _191, object result) {
|
||||
return_funcall1( ((closureN)self_736)->elts[0], result);;
|
||||
}
|
||||
|
||||
|
||||
void c_lib2_entry_pt(argc, env,cont) int argc; closure env,cont; {
|
||||
// static void c_entry_pt(argc, env,cont) int argc; closure env,cont; {
|
||||
// mclosure0(c_737, (function_type)__lambda_1);
|
||||
// __glo_call_95cc = &c_737;
|
||||
add_global((object *) &__glo_lib2_91hello);
|
||||
make_string(c_7312, "Hello from library #2");
|
||||
__glo_lib2_91hello = &c_7312;
|
||||
// TODO: How to assign lib2 to Cyc_global_variables?
|
||||
make_cvar(cvar_7323, (object *)&__glo_lib2_91hello);make_cons(pair_7324, find_or_add_symbol("lib2-hello"), &cvar_7323);
|
||||
make_cons(c_1, &pair_7324, Cyc_global_variables);
|
||||
Cyc_global_variables = &c_1;
|
||||
|
||||
// __glo__85exception_91handler_91stack_85 = boolean_f;
|
||||
//
|
||||
// make_cvar(cvar_7318, (object *)&__glo_lib2_91hello);make_cons(pair_7319, find_or_add_symbol("lib2-hello"), &cvar_7318);
|
||||
// make_cvar(cvar_7320, (object *)&__glo__85exception_91handler_91stack_85);make_cons(pair_7321, find_or_add_symbol("*exception-handler-stack*"), &cvar_7320);
|
||||
// make_cvar(cvar_7322, (object *)&__glo_call_95cc);make_cons(pair_7323, find_or_add_symbol("call/cc"), &cvar_7322);
|
||||
//make_cons(c_7326, &pair_7319,nil);
|
||||
//make_cons(c_7325, &pair_7321, &c_7326);
|
||||
//make_cons(c_7324, &pair_7323, &c_7325);
|
||||
//Cyc_global_variables = &c_7324;
|
||||
//
|
||||
//
|
||||
// return_check1(__lambda_2,nil);
|
||||
}
|
||||
//main(int argc,char **argv)
|
||||
//{long stack_size = long_arg(argc,argv,"-s",STACK_SIZE);
|
||||
// long heap_size = long_arg(argc,argv,"-h",HEAP_SIZE);
|
||||
// global_stack_size = stack_size;
|
||||
// global_heap_size = heap_size;
|
||||
// main_main(stack_size,heap_size,(char *) &stack_size);
|
||||
// return 0;}
|
||||
139
examples/hello-library/int-test/libs/lib1.c
Normal file
139
examples/hello-library/int-test/libs/lib1.c
Normal file
|
|
@ -0,0 +1,139 @@
|
|||
/**
|
||||
** This file was automatically generated by the Cyclone scheme compiler
|
||||
**
|
||||
** (c) 2014 Justin Ethier
|
||||
** Version 0.0.1 (Pre-release)
|
||||
**
|
||||
**/
|
||||
|
||||
#define funcall1(cfn,a1) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(0, (closure)a1, cfn); } else { ((cfn)->fn)(1,cfn,a1);}
|
||||
/* Return to continuation after checking for stack overflow. */
|
||||
#define return_funcall1(cfn,a1) \
|
||||
{char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[1]; buf[0] = a1;\
|
||||
GC(cfn,buf,1); return; \
|
||||
} else {funcall1((closure) (cfn),a1); return;}}
|
||||
|
||||
/* Evaluate an expression after checking for stack overflow. */
|
||||
#define return_check1(_fn,a1) { \
|
||||
char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[1]; buf[0] = a1; \
|
||||
mclosure0(c1, _fn); \
|
||||
GC(&c1, buf, 1); return; \
|
||||
} else { (_fn)(1,(closure)_fn,a1); }}
|
||||
|
||||
#define funcall2(cfn,a1,a2) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(1, (closure)a1, cfn,a2); } else { ((cfn)->fn)(2,cfn,a1,a2);}
|
||||
/* Return to continuation after checking for stack overflow. */
|
||||
#define return_funcall2(cfn,a1,a2) \
|
||||
{char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[2]; buf[0] = a1;buf[1] = a2;\
|
||||
GC(cfn,buf,2); return; \
|
||||
} else {funcall2((closure) (cfn),a1,a2); return;}}
|
||||
|
||||
/* Evaluate an expression after checking for stack overflow. */
|
||||
#define return_check2(_fn,a1,a2) { \
|
||||
char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[2]; buf[0] = a1;buf[1] = a2; \
|
||||
mclosure0(c1, _fn); \
|
||||
GC(&c1, buf, 2); return; \
|
||||
} else { (_fn)(2,(closure)_fn,a1,a2); }}
|
||||
|
||||
#include "cyclone.h"
|
||||
object __glo_lib1_91hello = nil;
|
||||
object __glo_internal_91func = nil;
|
||||
object __glo_lib1_91test = nil;
|
||||
extern object __glo__85Cyc_91version_91banner_85;
|
||||
extern object __glo_call_91with_91current_91continuation;
|
||||
extern object __glo_call_95cc;
|
||||
extern object __glo_char_123_127;
|
||||
extern object __glo_char_121_127;
|
||||
extern object __glo_char_125_127;
|
||||
extern object __glo_char_121_123_127;
|
||||
extern object __glo_char_125_123_127;
|
||||
extern object __glo_char_91upcase;
|
||||
extern object __glo_char_91downcase;
|
||||
extern object __glo_char_91alphabetic_127;
|
||||
extern object __glo_char_91upper_91case_127;
|
||||
extern object __glo_char_91lower_91case_127;
|
||||
extern object __glo_char_91numeric_127;
|
||||
extern object __glo_char_91whitespace_127;
|
||||
extern object __glo_digit_91value;
|
||||
extern object __glo_foldl;
|
||||
extern object __glo_foldr;
|
||||
extern object __glo_not;
|
||||
extern object __glo_list_127;
|
||||
extern object __glo_zero_127;
|
||||
extern object __glo_positive_127;
|
||||
extern object __glo_negative_127;
|
||||
extern object __glo_append;
|
||||
extern object __glo__list;
|
||||
extern object __glo_make_91list;
|
||||
extern object __glo_list_91copy;
|
||||
extern object __glo_map;
|
||||
extern object __glo_for_91each;
|
||||
extern object __glo_list_91tail;
|
||||
extern object __glo_list_91ref;
|
||||
extern object __glo_list_91set_67;
|
||||
extern object __glo_reverse;
|
||||
extern object __glo_boolean_123_127;
|
||||
extern object __glo_symbol_123_127;
|
||||
extern object __glo_Cyc_91obj_123_127;
|
||||
extern object __glo_make_91string;
|
||||
extern object __glo_error;
|
||||
extern object __glo_raise;
|
||||
extern object __glo_raise_91continuable;
|
||||
extern object __glo_with_91exception_91handler;
|
||||
extern object __glo__85exception_91handler_91stack_85;
|
||||
extern object __glo_Cyc_91add_91exception_91handler;
|
||||
extern object __glo_Cyc_91remove_91exception_91handler;
|
||||
extern object __glo_lib2_91hello;
|
||||
#include "runtime.h"
|
||||
void __lambda_2(int argc, closure _,object k_738) ;
|
||||
void __lambda_1(int argc, object self_7310, object r_739) ;
|
||||
void __lambda_0(int argc, closure _,object k_735) ;
|
||||
|
||||
void __lambda_2(int argc, closure _,object k_738) {
|
||||
|
||||
closureN_type c_7318;
|
||||
c_7318.tag = closureN_tag;
|
||||
c_7318.fn = __lambda_1;
|
||||
c_7318.num_elt = 1;
|
||||
c_7318.elts = (object *)alloca(sizeof(object) * 1);
|
||||
c_7318.elts[0] = k_738;
|
||||
|
||||
return_funcall1( __glo_internal_91func, &c_7318);;
|
||||
}
|
||||
|
||||
void __lambda_1(int argc, object self_7310, object r_739) {
|
||||
|
||||
make_int(c_7321, 1);
|
||||
return_funcall1( ((closureN)self_7310)->elts[0], &c_7321);;
|
||||
}
|
||||
|
||||
void __lambda_0(int argc, closure _,object k_735) {
|
||||
return_funcall1( k_735, Cyc_write(__glo_lib2_91hello));;
|
||||
}
|
||||
|
||||
void c_libslib1_entry_pt(argc, env,cont) int argc; closure env,cont; {
|
||||
|
||||
add_global((object *) &__glo_lib1_91hello);
|
||||
add_global((object *) &__glo_internal_91func);
|
||||
add_global((object *) &__glo_lib1_91test);
|
||||
mclosure0(c_7316, (function_type)__lambda_2);
|
||||
__glo_lib1_91hello = &c_7316;
|
||||
mclosure0(c_7312, (function_type)__lambda_0);
|
||||
__glo_internal_91func = &c_7312;
|
||||
make_string(c_7311, "test of include from a library");
|
||||
__glo_lib1_91test = &c_7311;
|
||||
|
||||
make_cvar(cvar_7325, (object *)&__glo_lib1_91hello);make_cons(pair_7326, find_or_add_symbol("lib1-hello"), &cvar_7325);
|
||||
make_cvar(cvar_7327, (object *)&__glo_internal_91func);make_cons(pair_7328, find_or_add_symbol("internal-func"), &cvar_7327);
|
||||
make_cvar(cvar_7329, (object *)&__glo_lib1_91test);make_cons(pair_7330, find_or_add_symbol("lib1-test"), &cvar_7329);
|
||||
make_cons(c_7333, &pair_7326,Cyc_global_variables);
|
||||
make_cons(c_7332, &pair_7328, &c_7333);
|
||||
make_cons(c_7331, &pair_7330, &c_7332);
|
||||
Cyc_global_variables = &c_7331;}
|
||||
58
examples/hello-library/int-test/libs/lib2.c
Normal file
58
examples/hello-library/int-test/libs/lib2.c
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
/**
|
||||
** This file was automatically generated by the Cyclone scheme compiler
|
||||
**
|
||||
** (c) 2014 Justin Ethier
|
||||
** Version 0.0.1 (Pre-release)
|
||||
**
|
||||
**/
|
||||
|
||||
#define funcall1(cfn,a1) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(0, (closure)a1, cfn); } else { ((cfn)->fn)(1,cfn,a1);}
|
||||
/* Return to continuation after checking for stack overflow. */
|
||||
#define return_funcall1(cfn,a1) \
|
||||
{char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[1]; buf[0] = a1;\
|
||||
GC(cfn,buf,1); return; \
|
||||
} else {funcall1((closure) (cfn),a1); return;}}
|
||||
|
||||
/* Evaluate an expression after checking for stack overflow. */
|
||||
#define return_check1(_fn,a1) { \
|
||||
char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[1]; buf[0] = a1; \
|
||||
mclosure0(c1, _fn); \
|
||||
GC(&c1, buf, 1); return; \
|
||||
} else { (_fn)(1,(closure)_fn,a1); }}
|
||||
|
||||
#define funcall2(cfn,a1,a2) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(1, (closure)a1, cfn,a2); } else { ((cfn)->fn)(2,cfn,a1,a2);}
|
||||
/* Return to continuation after checking for stack overflow. */
|
||||
#define return_funcall2(cfn,a1,a2) \
|
||||
{char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[2]; buf[0] = a1;buf[1] = a2;\
|
||||
GC(cfn,buf,2); return; \
|
||||
} else {funcall2((closure) (cfn),a1,a2); return;}}
|
||||
|
||||
/* Evaluate an expression after checking for stack overflow. */
|
||||
#define return_check2(_fn,a1,a2) { \
|
||||
char stack; \
|
||||
if (check_overflow(&stack,stack_limit1)) { \
|
||||
object buf[2]; buf[0] = a1;buf[1] = a2; \
|
||||
mclosure0(c1, _fn); \
|
||||
GC(&c1, buf, 2); return; \
|
||||
} else { (_fn)(2,(closure)_fn,a1,a2); }}
|
||||
|
||||
#include "cyclone.h"
|
||||
object __glo_lib2_91hello = nil;
|
||||
#include "runtime.h"
|
||||
|
||||
void c_libslib2_entry_pt(argc, env,cont) int argc; closure env,cont; {
|
||||
|
||||
add_global((object *) &__glo_lib2_91hello);
|
||||
make_string(c_733, "Hello from library #2");
|
||||
__glo_lib2_91hello = &c_733;
|
||||
|
||||
make_cvar(cvar_737, (object *)&__glo_lib2_91hello);make_cons(pair_738, find_or_add_symbol("lib2-hello"), &cvar_737);
|
||||
make_cons(c_739, &pair_738,Cyc_global_variables);
|
||||
Cyc_global_variables = &c_739;
|
||||
}
|
||||
Loading…
Add table
Reference in a new issue