Changeset 25756 in project


Ignore:
Timestamp:
01/03/12 09:41:02 (9 years ago)
Author:
Ivan Raikov
Message:

9ML-toolkit: the beginnings of a hook interface for defining various syntactic shortcuts

Location:
release/4/9ML-toolkit/trunk
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • release/4/9ML-toolkit/trunk/9ML-toolkit.scm

    r25697 r25756  
    33;;
    44;;
    5 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     5;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    66;; Science and Technology.
    77;;
  • release/4/9ML-toolkit/trunk/NineML.grm

    r25647 r25756  
    88;;
    99;;
    10 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     10;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    1111;; Science and Technology.
    1212;;
     
    7979    (VALUE IDENT valbind valexpr)          : (Let0 $2 $3 $4)
    8080    (IF valexpr THEN valexpr ELSE valexpr) : (ternop "cond" $2 $4 $6)
    81     (SEXPR)                                : (let ((sexpr (read (open-input-string (list->string (reverse $1))))))
    82                                                (parse-sexpr-macro sexpr))
     81    (SEXPR)                                : (let ((sexpr-label (and (sexpr-macro-label $1) (string->symbol (sexpr-macro-label $1))))
     82                                                   (sexpr-text (read (open-input-string (list->string (reverse (sexpr-macro-text $1)))))))
     83                                               (parse-sexpr-macro (make-sexpr-macro sexpr-label sexpr-text)))
    8384                                                                 
    8485    )
  • release/4/9ML-toolkit/trunk/NineML.l

    r25647 r25756  
    88;;
    99;;
    10 ;; Copyright 2010 Ivan Raikov and the Okinawa Institute of
     10;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    1111;; Science and Technology.
    1212;;
     
    7878
    7979
    80 "["                       (let loop ((kont (lambda (x) (tok yyline SEXPR x))) (result '(#\()))
     80"["                       (let loop ((kont (lambda (x) (tok yyline SEXPR (make-sexpr-macro #f x))))
     81                                     (result '(#\()))
    8182                             (let ((c (yygetc)))
    8283                               (cond ((eq? 'eof c)    (lexer-error "unexpected end of expression"))
     
    8687                                     )))
    8788
    88 "#["                       (let loop ((kont (lambda (x) (tok yyline QEXPR x))) (result '(#\()))
     89"@"{lower}"["            (let ((label (substring yytext 2 (- (string-length yytext) 1))))
     90                            (let loop ((kont (lambda (x) (tok yyline SEXPR (make-sexpr-macro label x))))
     91                                       (result '(#\()))
     92                             (let ((c (yygetc)))
     93                               (cond ((eq? 'eof c)    (lexer-error "unexpected end of expression"))
     94                                     ((char=? #\] c)  (kont (cons #\) result)))
     95                                     ((char=? #\[ c)  (loop (lambda (x) (loop kont (append x result))) '(#\()))
     96                                     (else            (loop kont (cons c result)))
     97                                     ))
     98                             ))
     99
     100"#["                       (let loop ((kont (lambda (x) (tok yyline QEXPR x)))
     101                                      (result '(#\()))
    89102                             (let ((c (yygetc)))
    90103                               (cond ((eq? 'eof c)    (lexer-error "unexpected end of expression"))
  • release/4/9ML-toolkit/trunk/ivp-chicken.scm

    r25697 r25756  
    33;;
    44;;
    5 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     5;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    66;; Science and Technology.
    77;;
  • release/4/9ML-toolkit/trunk/ivp-mlton.scm

    r23886 r25756  
    33;;
    44;;
    5 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     5;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    66;; Science and Technology.
    77;;
  • release/4/9ML-toolkit/trunk/ivp-octave-mlton.scm

    r24541 r25756  
    33;;
    44;;
    5 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     5;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    66;; Science and Technology.
    77;;
  • release/4/9ML-toolkit/trunk/ivp-octave.scm

    r25514 r25756  
    33;;
    44;;
    5 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     5;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    66;; Science and Technology.
    77;;
  • release/4/9ML-toolkit/trunk/ivp.scm

    r25697 r25756  
    33;;
    44;;
    5 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     5;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    66;; Science and Technology.
    77;;
  • release/4/9ML-toolkit/trunk/parse.scm

    r25647 r25756  
    77;;
    88;;
    9 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     9;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    1010;; Science and Technology.
    1111;;
     
    2727(module 9ML-parse
    2828
    29         (parse parse-sexpr-macro parse-string-expr parse-sym-expr nineml-xmlns parse-al-sxml-component parse-al-sxml)
     29        (parse parse-sexpr-macro parse-string-expr parse-sym-expr
     30         nineml-xmlns parse-al-sxml-component parse-al-sxml
     31         register-sexpr-macro-hook)
    3032
    3133        (import scheme chicken)
     
    6668    ((tok loc t l) (make-lexical-token (quasiquote t) loc l))))
    6769
     70
     71
     72(define-record-type sexpr-macro
     73  (make-sexpr-macro label text)
     74  sexpr-macro?
     75  (label sexpr-macro-label)
     76  (text sexpr-macro-text))
     77
     78
     79
     80(define-record-type algebraic-eqn
     81  (make-algebraic-eqn quantity rhs)
     82  algebraic-eqn?
     83  (quantity algebraic-eqn-quantity)
     84  (rhs algebraic-eqn-rhs))
     85
     86
     87(define-record-type ode-eqn
     88  (make-ode-eqn indep dep tstep rhs)
     89  ode-eqn?
     90  (indep ode-eqn-indep)
     91  (dep   ode-eqn-dep)
     92  (tstep ode-eqn-tstep)
     93  (rhs   ode-eqn-rhs))
     94
     95
     96(define-record-type relation
     97  (make-relation quantity var rhs)
     98  relation?
     99  (quantity relation-quantity)
     100  (var      relation-var)
     101  (rhs      relation-rhs))
     102
     103
     104(define (ode-eqn-or-relation? x)
     105  (or (ode-eqn? x) (relation? x)))
     106
     107
     108
     109(define sexpr-macro-hooks (make-parameter '()))
     110
     111
     112(define (register-macro-hook label hook)
     113  (assert (procedure? hook))
     114  (if (not (symbol? label))
     115      (error 'register-macro-hook "hook label must be a symbol" label))
     116  (if (assoc label (sexpr-macro-hooks))
     117      (error 'register-macro-hook "hook already exists" label))
     118  (sexpr-macro-hooks (cons (cons label hook) (sexpr-macro-hooks)))
     119  )
     120
     121
     122(define (parse-sexpr-macro x)
     123  (if (sexpr-macro? x)
     124      (let ((label (sexpr-macro-label x)))
     125        (if (not label)
     126            (let ((default-handler (cdr (assoc 'default (sexpr-macro-hooks)))))
     127              (default-handler x))
     128            (cond ((assoc label (sexpr-macro-hooks)) =>
     129                   (lambda (v) ((cdr v) (sexpr-macro-text x))))
     130                  (else
     131                   (error 'parse-sexpr-macro "cannot find handler for macro" label))
     132                  )))
     133        ))
     134
     135
     136
    68137(include "NineML.grm.scm")
    69138(include "NineML.l.scm")
    70139(include "expr-parser.scm")
     140
    71141
    72142(define (make-parse-error loc)
     
    84154
    85155
    86 (define-record-type algebraic-eqn
    87   (make-algebraic-eqn quantity rhs)
    88   algebraic-eqn?
    89   (quantity algebraic-eqn-quantity)
    90   (rhs algebraic-eqn-rhs))
    91 
    92 
    93 (define-record-type ode-eqn
    94   (make-ode-eqn indep dep tstep rhs)
    95   ode-eqn?
    96   (indep ode-eqn-indep)
    97   (dep   ode-eqn-dep)
    98   (tstep ode-eqn-tstep)
    99   (rhs   ode-eqn-rhs))
    100 
    101 
    102 (define-record-type relation
    103   (make-relation quantity var rhs)
    104   relation?
    105   (quantity relation-quantity)
    106   (var      relation-var)
    107   (rhs      relation-rhs))
    108 
    109 
    110 (define (ode-eqn-or-relation? x)
    111   (or (ode-eqn? x) (relation? x)))
     156(define (parse loc s)
     157  (cond ((port? s)   (lexer-init 'port s))
     158        ((string? s) (lexer-init 'string s))
     159        (else (error 'parse "bad argument type; not a string or port" s)) )
     160   (parser lexer (make-parse-error loc)))
    112161
    113162
     
    298347              (Longid (Pident (ident-create (->string tstep)))))
    299348             (make-group (map make-pure (map ode-eqn-rhs eqlst)))))
    300            (else (error 'parse-sexpr-macro "invalid system of ODE equations" eqlst)))))
     349           (else (error 'parse-NineML-equation-sexpr-macro "invalid system of ODE equations" eqlst)))))
    301350
    302351
     
    316365               (make-relations relations (make-group (map make-pure (map ode-eqn-rhs ode-eqs))))))
    317366             
    318              (else (error 'parse-sexpr-macro "invalid system of DAE equations" eqlst))
     367             (else (error 'parse-NineML-equation-sexpr-macro "invalid system of DAE equations" eqlst))
    319368             ))))
    320369
    321 (define (parse-sexpr-macro lst)
     370(define (parse-NineML-equation-sexpr-macro lst)
    322371  (match lst
    323372
     
    347396                         
    348397                 (else
    349                   (error 'parse-sexpr-macro "invalid system of equations" eqlst)))))
     398                  (error 'parse-NineML-equation-sexpr-macro "invalid system of equations" eqlst)))))
    350399               
    351         (else (error 'parse-sexpr-macro "invalid equational expression" lst))
     400        (else (error 'parse-NineML-equation-sexpr-macro "invalid equational expression" lst))
    352401        ))
    353402
    354 
    355 (define (parse loc s)
    356   (cond ((port? s)   (lexer-init 'port s))
    357         ((string? s) (lexer-init 'string s))
    358         (else (error 'parse "bad argument type; not a string or port" s)) )
    359    (parser lexer (make-parse-error loc)))
     403(define (parse-list-sexpr-macro text)
     404  (let recur ((text (reverse text))
     405              (lst '()))
     406    (if (null? text) lst
     407        (recur (cdr lst) (Apply list-cons (parse (car text)) lst)))
     408    ))
     409
    360410
    361411
     
    498548    ))
    499549
    500 
     550(register-macro-hook 'default parse-NineML-equation-sexpr-macro)
     551(register-macro-hook 'list parse-list-sexpr-macro)
    501552
    502553)
  • release/4/9ML-toolkit/trunk/report.scm

    r25697 r25756  
    33;;
    44;;
    5 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     5;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    66;; Science and Technology.
    77;;
  • release/4/9ML-toolkit/trunk/repr.scm

    r25731 r25756  
    33;; Different external representations of NineML.
    44;;
    5 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     5;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    66;; Science and Technology.
    77;;
  • release/4/9ML-toolkit/trunk/shell.scm

    r25697 r25756  
    33;;
    44;;
    5 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     5;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    66;; Science and Technology.
    77;;
  • release/4/9ML-toolkit/trunk/ulp.scm

    r25697 r25756  
    33;;
    44;;
    5 ;; Copyright 2010-2011 Ivan Raikov and the Okinawa Institute of
     5;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
    66;; Science and Technology.
    77;;
Note: See TracChangeset for help on using the changeset viewer.