Changeset 38915 in project


Ignore:
Timestamp:
08/29/20 21:00:37 (4 weeks ago)
Author:
Kon Lovett
Message:

remove unused standard grammar items, add read-sexps (; delimiter - std-grm), add tests, mv read-sexp-string to test

Location:
release/5/slib-prec/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/slib-prec/trunk/slib-prec-grammar.scm

    r38717 r38915  
    3838  make-delimited-parse-grammar-reader
    3939  make-delimited-sexp-reader
    40   read-sexp-from-string)
     40  ;
     41  read-sexps)
    4142
    4243(import scheme)
    4344(import (chicken base))
    4445(import (chicken type))
    45 (import (only (srfi 1) iota))
     46(import (only (srfi 1) iota reverse!))
    4647(import slib-prec-parse)
    4748
     
    169170;;
    170171
    171 (define (read-sexp-from-string str #!optional (grm (active-input-grammar)) (column 0))
    172   (import (only (chicken port) with-input-from-string))
    173   (with-input-from-string str (cut read-sexp grm column)) )
    174 
    175 ;;
    176 
    177172(define *input-grammar*)
    178173(define *output-grammar*)
     
    191186(define (active-echo-grammar) (receive (i o e) (active-grammar) e))
    192187
     188;;
     189
     190(define (read-sexps #!optional (port (current-input-port)) (grammar (active-input-grammar)) (column 0))
     191  (parameterize ((current-input-port port))
     192    (let loop ((ls '()) (col column))
     193      (let* (
     194        (reader (cut read-sexp grammar col))
     195        (sexp (reader)) )
     196        (if (eof-object? sexp)
     197          (reverse! ls)
     198          ;FIXME track column!
     199          (loop (cons sexp ls) 0) ) ) ) ) )
     200
    193201) ;slib-prec-grammar
  • release/5/slib-prec/trunk/slib-standard-grammar.scm

    r38914 r38915  
    4848(prec:define-grammar (tok:char-group 51 '(#\+ #\-) list2string))
    4949
    50 (prec:define-grammar (tok:char-group 30 '(#\< #\> #\= #\: #\~ #\!) list2string))
     50(prec:define-grammar (tok:char-group 30 '(#\< #\> #\= #\: #\~ #\! #\%) list2string))
    5151
    5252(prec:define-grammar (tok:char-group 39 #\| list2string))
     
    5454(prec:define-grammar (tok:char-group 41 #\^ list2string))
    5555
    56 ;numbers, but not 1/4
     56;numbers, but not ratios!
    5757(define tok:number-chars (string-append "." tok:decimal-digits))
    5858(prec:define-grammar (tok:char-group 40
     
    8787(prec:define-grammar (prec:prefix '! 'not 70))
    8888
    89 ;(prec:define-grammar (prec:prefix ":" 'settemplate! 20))
    90 
    9189;;;nary operators
    9290(prec:define-grammar (prec:nary '* '* 120))
     
    104102
    105103;;;infix operators
    106 ;(prec:infix 'x 'crossproduct 111 110)
    107 ;(prec:define-grammar (prec:infix #\. 'ncmult 110 109))
     104(prec:define-grammar (prec:infix '** 'expt 140 139))
     105(prec:define-grammar (prec:infix '% 'modulo 140 139))
    108106
    109 ;(prec:define-grammar (prec:infix '(^ **) '^ 140 139))
    110 (prec:define-grammar (prec:infix '** 'expt 140 139))
    111 
    112 ;(prec:define-grammar (prec:infix '^^ '^^ 210 210))
    113 
    114 ;(prec:define-grammar (prec:infix '(":=" ":") 'define 180 20))
    115107(prec:define-grammar (prec:infix ': 'define 180 20))
    116108
     
    121113(prec:define-grammar (prec:infix '>= '>= 80 80))
    122114
    123 ;(prec:define-grammar (prec:infix '(~= <>) '<> 80 80))
    124 (prec:define-grammar (prec:infix '<> '<> 80 80))
    125 
    126 (prec:define-grammar (prec:infix '~= '~= 80 80))
    127 
    128 (prec:define-grammar (prec:infix 'mod 'mod 70 70))
    129 
    130 (prec:define-grammar (prec:infix ':: 'suchthat 190 40))
    131 
    132115;;;postfix operators
    133 ;(prec:define-grammar (prec:postfix '! 'factorial 160))
    134 ;(prec:define-grammar (prec:postfix #\' 'differential 170))
    135116
    136117;;;matchfix operators
    137 (prec:define-grammar (prec:matchfix #\( identity #f #\))) ;MUST be procedure
     118(prec:define-grammar (prec:matchfix #\( identity #f #\))) ;MUST NOT be procedure
    138119(prec:define-grammar (prec:matchfix #\[ 'vector #\, #\]))
    139 
    140 ;(prec:define-grammar (prec:matchfix #\{ 'or #\, #\} (prec:infix "|" 'suchthat 190 40)))
    141120
    142121(prec:define-grammar (prec:matchfix #\\ 'lambda #\, #\;))
    143122
    144 ;(prec:define-grammar (prec:matchfix "|" 'abs #f "|"))
    145 
    146123;;;special operators
    147124(prec:define-grammar (prec:inmatchfix #\( list #\, #\) 200)) ;MUST be procedure
    148 ;(prec:define-grammar (prec:inmatchfix #\[ 'rapply #\, #\] 200))
    149125
    150126;;;rest operator reads expressions up to next delimiter.
    151 ;(prec:define-grammar (prec:prestfix 'set 'set 10))
    152 ;(prec:define-grammar (prec:prestfix 'show 'show 10))
    153127
    154128;;;miscellany
    155 ;(prec:define-grammar (prec:prefix 'load 'load 50))
    156 ;(prec:define-grammar (prec:nofix '% '%))
    157 ;(prec:define-grammar (prec:nofix 'help 'help))
    158 ;(prec:define-grammar (prec:nofix 'qed 'qed))
    159129
    160130(prec:define-grammar (prec:commentfix
  • release/5/slib-prec/trunk/tests/slib-prec-test.scm

    r38914 r38915  
    1313
    1414(import (chicken base))
     15(import (chicken port))
    1516(import utf8)
    1617(import utf8-srfi-13)
     
    1819;; Operator Aliaes
    1920
    20 (define ^ expt)
    21 (define mod modulo)
    22 
    23 ;;
     21;; Grammars
    2422
    2523;defgrammar doesn't `define'
     
    4442;;
    4543
     44(define (read-sexp-string str #!optional (grammar (active-input-grammar)) (column 0))
     45  (import (only (chicken port) with-input-from-string))
     46  (with-input-from-string str (cut read-sexp grammar column)) )
     47
    4648(define-syntax test-parse
    4749  (syntax-rules ()
    4850    ((test-parse ?out ?in)
    49       (test ?in ?out (read-sexp-from-string ?in)) )
     51      (test ?in ?out (read-sexp-string ?in)) )
    5052    ((test-parse ?msg ?out ?in)
    51       (test ?msg ?out (read-sexp-from-string ?in)) ) ) )
     53      (test ?msg ?out (read-sexp-string ?in)) ) ) )
    5254
    53 (test-group "Arithmetic Grammer (Jacal, English, derived)"
     55; (derived from Jacal English)
     56(test-group "Arithmetic Grammer"
    5457
    55   (test-parse '(+ 1 (* 2 a)) "1 + 2 * a")
    56   (test-parse '(+ 1 2 (* abc a)) "1 + 2 + abc * a")
    57   (test-parse '(* (+ 1 2) (f a b)) "(1 + 2) * f(a, b)")
    58   (test-parse '(expt (+ 1 2) (f a b)) "(1 + 2) ** f(a, b)")
     58  (test-parse
     59                '(+ 1 (* 2 a))
     60                "1 + 2 * a")
     61  (test-parse
     62                '(+ 1 2 (* abc a))
     63                "1 + 2 + abc * a")
     64  (test-parse
     65                '(* (+ 1 2) (f a b))
     66                "(1 + 2) * f(a, b)")
     67  (test-parse
     68                '(/ (expt (+ 1 2) (f a b)) x)
     69                "(1 + 2) ** f(a, b) / x")
    5970
    6071  (test-parse
     
    6475    '(and (/ (* (+ 1 2) (f a b)) 27.9) PI)
    6576    "(1 + 2) * f(a, b) / 27.9 && PI")
    66 
    6777  (test-parse
    68     `(or (< a b) (and (f x) (~= i j)))
    69     "a < b || f(x) && i ~= j")
    70 
     78    '(or (< a b) (and (f x) (> i (+ (modulo j 3) x))))
     79    "a < b || f(x) && i > j % 3 + x")
    7180  (test-parse
    7281    '(or (and BAZ PI) (and FOO BAR))
     
    8392    "a | b & c ^ ~b | d")
    8493
     94  (test-parse
     95    '(define f (lambda a (+ (first a) (second a)) (apply r a)))
     96    "f : \\a, first(a) + second(a), apply(r, a);")
     97
    8598  ;FIXME handle ratios ? / in a/b vs a / b ?
    8699  #; ; "N/D (ratio) => (/ N D)"
     
    89102  (test-parse '(/ (* (+ 1 2) 1) 5) "(1 + 2) * 1/5")
    90103
    91   (test 15 (eval (read-sexp-from-string "(1 + 2) * 5;")))
    92   (test 15.0 (eval (read-sexp-from-string "(1.0 + 2) * 5")))
    93   (test 3/5 (eval (read-sexp-from-string "(1 + 2) * 1/5")))
     104  ;NOTE whitespace is not a delimiter
     105  (test 15 (eval (read-sexp-string "(1 +2)* 5;")))
     106  (test 15.0 (eval (read-sexp-string "(1.0+ 2) * 5")))
     107  (test 3/5 (eval (read-sexp-string "(1 + 2) *1/5")))
     108  (test 8 (eval (read-sexp-string "2 **3")))
    94109
    95   (test 8 (eval (read-sexp-from-string "2**3")))
     110  (test
     111    '((+ (first a) (second a)) (apply r a) (- 23 skidoo))
     112    (with-input-from-string
     113      "first(a) + second(a); apply(r, a); 23-skidoo"
     114      read-sexps))
     115
     116  ;FIXME handle infinities & nan
     117  (test
     118    '((define f (lambda a (+ (first a) (second a)) (apply r a))) (f 1 (+ inf.0)))
     119    (with-input-from-string
     120     ;NOTE ;; is lambda-right-delim + expression-delim
     121      "f : \\a, first(a) + second(a), apply(r, a);; f(1,+inf.0)"
     122      read-sexps))
    96123)
    97124
Note: See TracChangeset for help on using the changeset viewer.