Re: Q on (language <lang> spec)

[Matt Wette]

On Oct 17, 2015, at 12:02 PM, Matt Wette <address@hidden> wrote:

I am playing with the compiler tower and have been digging through the (system base language) module to try to get my hands around writing to the compiler tower.  .

Here is a simple calculator example that I have working with my own intermediate (SXML based) language. 

scheme@(guile-user)> ,L calc

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

calc@(guile-user)> a = (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 = 0.8433734939759036

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

All files are:

;;; Copyright (C) 2015 Matthew R. Wette

;;;

;;; 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 "=" 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)))