scheme@(guile-user)> ,L calc

Happy hacking with calc! To switch back, type `,L = scheme'.

calc@(guile-user)> a =3D (2.5 + 4.5)/(9.3 - 1)

calc@(guile-user)> ,L scheme

Happy hacking with Scheme! To switch back, type `,L = calc'.

scheme@(guile-user)> a

$1 =3D 0.8433734939759036

The implementation consists of the = files spec.scm, parser.scm and compiler.scm which are listed = below.

All = files are:

;;;

;;; This program is free software: you can redistribute it = and/or modify

;;; it under the terms of the GNU General Public License as = published by

;;; the Free Software Foundation, either version 3 of the = License, or

;;; (at your option) any later version.

and to appear at https://savannah.nongnu.org/projects/nyacc.

spec.scm:

(define-module (language calc spec)

#:export (calc)

#:use-module (system base language)

#:use-module (nyacc lang calc parser)

#:use-module (nyacc lang calc compiler))

(define (calc-reader port env)

(let ((iport (current-input-port)))

(dynamic-wind

(lambda () = (set-current-input-port port))

(lambda () (calc-parse #:debug = #f))

(lambda () = (set-current-input-port iport)))))

(define-language calc

#:title "calc"

#:reader calc-reader

#:compilers `((tree-il . = ,calc-sxml->tree-il))

#:printer write)

parser.scm:

(define-module (nyacc lang calc = parser)

#:export (calc-parse calc-spec calc-mach)

#:use-module (nyacc lalr)

#:use-module (nyacc lex)

#:use-module (nyacc parse)

)

(define calc-spec

(lalr-spec

(prec< (left "+" "-") (left "*" "/"))

(start stmt-list-proxy)

(grammar

(stmt-list-proxy

(stmt-list "\n" ($$ (cons 'stmt-list = (reverse $1)))))

(stmt-list

(stmt ($$ (list $1)))

(stmt-list ";" stmt ($$ (cons $3 = $1))))

(stmt

(ident "=3D" expr ($$ `(assn-stmt ,$1 = ,$3)))

(expr ($$ `(expr-stmt ,$1)))

( ($$ '(empty-stmt))))

(expr

(expr "+" expr ($$ `(add ,$1 ,$3)))

(expr "-" expr ($$ `(sub ,$1 ,$3)))

(expr "*" expr ($$ `(mul ,$1 ,$3)))

(expr "/" expr ($$ `(div ,$1 ,$3)))

('$fixed ($$ `(fixed ,$1)))

('$float ($$ `(float ,$1)))

("(" expr ")" ($$ $2)))

(ident ('$ident ($$ = `(ident ,$1))))

)))

(define calc-mach

= (compact-machine

(hashify-machine

(make-lalr-machine calc-spec))))

(define = calc-parse

(let ((gen-lexer (make-lexer-generator = (assq-ref calc-mach 'mtab)

= = #:space-chars " \t"))

(parser (make-lalr-ia-parser = calc-mach)))

(lambda* (#:key (debug #f)) (parser (gen-lexer) = #:debug debug))))

compiler.scm:

(define-module (nyacc lang calc compiler)

#:export (calc-sxml->tree-il)

#:use-module (sxml match)

#:use-module (sxml fold)

;;#:use-module (system base language)

#:use-module (language tree-il))

(define (fup tree)

(sxml-match tree

((fixed ,fx) `(const ,(string->number = fx)))

((float ,fl) `(const ,(string->number = fl)))

((ident ,id) `(toplevel ,(string->symbol = id)))

((add ,lt ,rt) `(apply (toplevel +) ,lt = ,rt))

((sub ,lt ,rt) `(apply (toplevel -) ,lt = ,rt))

((mul ,lt ,rt) `(apply (toplevel *) ,lt = ,rt))

((div ,lt ,rt) `(apply (toplevel /) ,lt = ,rt))

((assn-stmt (toplevel ,lhs) ,rhs) `(define ,lhs = ,rhs))

((empty-stmt) '(begin))

((stmt-list ,items ...) `(begin ,items = ...))

(,otherwise tree)))

(define (calc-sxml->tree-il exp env opts)

(let* ((tree (foldt fup identity exp))

(code (parse-tree-il = tree)))

(values code env env)))