diff --git a/counter.scm b/counter.scm new file mode 100644 index 0000000..ee32923 --- /dev/null +++ b/counter.scm @@ -0,0 +1,13 @@ +(module + (defconst makeCounter + (fn (init) + (var value init) + (return (%r + (: increment (fn () (+= value 1))) + (: decrement (fn () (-= value 1))) + (: makeOffsetCounter + (fn (delta) + (return (makeCounter (+ value delta))))))))) + (defconst c1 (makeCounter 1)) + ($ c1 increment) + ($ console log ($ c1 decrement))) diff --git a/james-to-scheme.scm b/james-to-scheme.scm new file mode 100644 index 0000000..e0fc957 --- /dev/null +++ b/james-to-scheme.scm @@ -0,0 +1,189 @@ +;; DSL macros for James-like syntax + +(define-module (rockit james scheme-skin) + #:use-module (ice-9 hash-table) + ;; #:use-module (srfi srfi-88) ;; keyword objects + #:export (+= fn %r $ @ module return)) + +;; Macro for field access using (@ obj field) +(define-syntax @ + (syntax-rules () + ((_ obj field) + (hash-ref obj 'field)))) + +;; Macro for method calls using ($ target method args ...) +(define-syntax $ + (syntax-rules () + ((_ target method args ...) + ((hash-ref target 'method) args ...)))) + +;; Macro to expand %r into hash-table creation +(define-syntax %r + (syntax-rules (:) + ((_ (: key value) ...) + (let ((tbl (make-hash-table))) + (hash-set! tbl 'key value) ... + tbl)))) + +;; Helper macro to process body and handle bindings +(define-syntax process-body + (syntax-rules (var defconst return) + ;; When we see a var binding followed by more expressions + ((_ ((var name val) rest ...)) + (let ((name val)) + (process-body (rest ...)))) + ;; When we see just a var binding alone + ((_ ((var name val))) + (let ((name val)) + name)) + ;; When we see a defconst binding followed by more expressions + ((_ ((defconst name val) rest ...)) + (let ((name val)) + (process-body (rest ...)))) + ;; When we see just a defconst binding alone + ((_ ((defconst name val))) + (let ((name val)) + name)) + ;; Handle return - stop processing and return the value + ((_ ((return val) rest ...)) + val) + ((_ ((return val))) + val) + ;; Empty case + ((_ ()) + (if #f #f)) + ;; Single expression case + ((_ (expr)) + expr) + ;; Multiple expressions case + ((_ (first rest ...)) + (begin + first + (process-body (rest ...)))))) + +;; Macro to expand fn into lambda with begin, handling let bindings and rest args +(define-syntax fn + (syntax-rules (var rest:) + ((_ (args ... rest: rest-arg) body ...) + (lambda (args ... . rest-arg) + (process-body (body ...)))) + ((_ (args ...) body ...) + (lambda (args ...) + (process-body (body ...)))))) + +;; Macro to handle module bodies similar to fn but with defconst +(define-syntax module + (syntax-rules (defconst) + ((_ body ...) + (let () + (process-body (body ...)))))) + +;; Macro to expand += into a set! with addition +(define-syntax += + (syntax-rules () + ((_ var val) + (let ((new-val (+ var val))) + (set! var new-val) + new-val)))) + +;; Macro to expand -= into a set! with subtraction +(define-syntax -= + (syntax-rules () + ((_ var val) + (let ((new-val (- var val))) + (set! var new-val) + new-val)))) + +;; Define console object with log method +(define console + (%r (: log (fn (first rest: rest) + (display first) + (for-each (lambda (arg) + (display " ") + (display arg)) + rest) + (newline))))) + +;; Test case +(let ((x 5)) + ($ console log "x before:" x) + (+= x 1) + ($ console log "x after:" x)) + +;; Test fn macro +($ console log "\nTesting fn macro:") +(let ((add2 (fn (x) + ($ console log "Adding 2 to" x) + (+ x 2)))) + ($ console log "Result:" (add2 40))) + +;; Test %r macro with methods +($ console log "\nTesting %r macro with methods:") +(let ((point (%r + (: get-x (fn () 10)) + (: get-y (fn () 20))))) + ($ console log "Point x:" ($ point get-x)) + ($ console log "Point y:" ($ point get-y))) + +;; Test %r macro with simple properties +($ console log "\nTesting %r macro with properties:") +(let ((point (%r + (: x 10) + (: y 20)))) + ($ console log "Point x:" (@ point x)) + ($ console log "Point y:" (@ point y))) + +;; Test fn macro with var binding +($ console log "\nTesting fn macro with var:") +(let ((make-adder (fn (x) + ($ console log "Computing with input:" x) + (var result (+ x 2)) + ($ console log "Computed result:" result) + result))) + ($ console log "Result:" (make-adder 40))) + +;; Test module macro +($ console log "\nTesting module macro:") +(let ((result (module + (defconst pi 3.14159) + (defconst radius 2) + (defconst area (* pi (* radius radius))) + ($ console log "Computing circle area with radius:" radius) + area))) + ($ console log "Circle area:" result)) + +;; Test simple recursive doubler +($ console log "\nTesting simple recursive doubler:") +(let () + (define make-doubler + (fn (init) + (var value init) + (return (%r + (: double (fn () + ($ console log "Doubling:" value) + (if (< value 4) + ($ (make-doubler (* value 2)) double) + value))))))) + (define d1 (make-doubler 1)) + ($ d1 double)) + +;; Test counter object with makeOffsetCounter +($ console log "\nTesting counter with offset:") +(let () + (define make-counter + (fn (init) + (var value init) + (return (%r + (: increment (fn () (+= value 1))) + (: decrement (fn () (-= value 1))) + (: makeOffsetCounter + (fn (delta) + (return (make-counter (+ value delta))))))))) + (define c1 (make-counter 5)) + ($ console log "Initial counter at 5") + ($ c1 increment) + ($ console log "After increment:" ($ c1 decrement)) + (define c2 ($ c1 makeOffsetCounter 10)) + ($ console log "New counter with +10 offset") + ($ c2 increment) + ($ console log "After increment:" ($ c2 decrement)))