Changeset 38982 in project


Ignore:
Timestamp:
08/31/20 20:18:26 (4 weeks ago)
Author:
Kon Lovett
Message:

read-sexps port arg is after read-sexp args, group tests, add {,} list oper (like [,] vector)

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

Legend:

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

    r38979 r38982  
    188188;;
    189189
    190 (define (read-sexps #!optional (port (current-input-port)) (grammar (active-input-grammar)) (column 0))
     190(define (read-sexps #!optional (grammar (active-input-grammar)) (column 0) (port (current-input-port)))
    191191  (parameterize ((current-input-port port))
    192192    (let loop ((ls '()) (col column))
  • release/5/slib-prec/trunk/slib-standard-grammar.scm

    r38915 r38982  
    7474
    7575;;; Delimiters and Separators
    76 
    7776;;; Delimiters used to be defined here, but now are defined
    7877;;; dynamically by parse functions.
    79 (prec:define-grammar (prec:delim #;#\[ #\])) ;4 editor
     78;(prec:define-grammar (prec:delim #;#\[ #\])) ;4 editor
     79;(prec:define-grammar (prec:delim #;#\{ #\})) ;4 editor
    8080
    8181;;;prefix operators
     
    105105(prec:define-grammar (prec:infix '% 'modulo 140 139))
    106106
    107 (prec:define-grammar (prec:infix ': 'define 180 20))
    108 
    109107(prec:define-grammar (prec:infix '= '= 80 80))
    110108(prec:define-grammar (prec:infix '< '< 80 80))
     
    113111(prec:define-grammar (prec:infix '>= '>= 80 80))
    114112
     113(prec:define-grammar (prec:infix ':= 'define 180 20))
     114
    115115;;;postfix operators
    116116
    117117;;;matchfix operators
    118118(prec:define-grammar (prec:matchfix #\( identity #f #\))) ;MUST NOT be procedure
     119
     120(prec:define-grammar (prec:matchfix #\{ 'list #\, #\}))
    119121(prec:define-grammar (prec:matchfix #\[ 'vector #\, #\]))
    120122
  • release/5/slib-prec/trunk/tests/slib-prec-test.scm

    r38980 r38982  
    1313
    1414(import (chicken base))
    15 (import (chicken port))
    16 (import utf8)
    17 (import utf8-srfi-13)
     15(import (only (chicken port) with-input-from-string))
     16(import utf8 utf8-srfi-13)
    1817
    1918;; Operator Aliaes
     
    2322;defgrammar doesn't `define'
    2423(import slib-basic-grammars)
    25 (import slib-standard-grammar)
     24(import slib-standard-grammar)  ;(from JACAL English.scm)
    2625(import slib-tex-grammar)
    2726
     
    4342;;
    4443
    45 (define (read-sexp-string str #!optional (grammar (active-input-grammar)) (column 0))
    46   (import (only (chicken port) with-input-from-string))
     44(define (read-sexp/string str #!optional (grammar (active-input-grammar)) (column 0))
    4745  (with-input-from-string str (cut read-sexp grammar column)) )
    4846
    49 (define-syntax test-parse
    50   (syntax-rules ()
    51     ((test-parse ?out ?in)
    52       (test ?in ?out (read-sexp-string ?in)) )
    53     ((test-parse ?msg ?out ?in)
    54       (test ?msg ?out (read-sexp-string ?in)) ) ) )
     47(define (read-sexps/string str #!optional (grammar (active-input-grammar)) (column 0))
     48  (with-input-from-string str (cut read-sexps grammar column)) )
    5549
    56 ; (derived from Jacal English)
    57 (test-group "Arithmetic Grammer"
     50(test-group "Scheme Grammer"
    5851
    59   (test-parse
    60                 '(+ 1 (* 2 a))
    61                 "1 + 2 * a")
    62   (test-parse
    63                 '(+ 1 2 (* abc a))
    64                 "1 + 2 + abc * a")
    65   (test-parse
    66                 '(* (+ 1 2) (f a b))
    67                 "(1 + 2) * f(a, b)")
    68   (test-parse
    69                 '(/ (expt (+ 1 2) (f a b)) x)
    70                 "(1 + 2) ** f(a, b) / x")
     52  (test-group "Arithmetic"
     53    (test '(+ 1 (* 2 a)) (read-sexp/string "1 + 2 * a"))
     54    (test '(+ 1 2 (* abc a)) (read-sexp/string "1 + 2 + abc * a"))
     55    (test '(* (+ 1 2) (f a b)) (read-sexp/string "(1 + 2) * f(a, b)"))
     56    (test '(/ (expt (+ 1 2) (f a b)) x) (read-sexp/string "(1 + 2) ** f(a, b) / x"))
     57  )
    7158
    72   (test-parse
    73     '(or (/ (* (+ 1 2) (f a b)) 27.9) PI)
    74     "(1 + 2) * f(a, b) / 27.9 || PI")
    75   (test-parse
    76     '(and (/ (* (+ 1 2) (f a b)) 27.9) PI)
    77     "(1 + 2) * f(a, b) / 27.9 && PI")
    78   (test-parse
    79     '(or (< a b) (and (f x) (> i (+ (modulo j 3) x))))
    80     "a < b || f(x) && i > j % 3 + x")
    81   (test-parse
    82     '(or (and BAZ PI) (and FOO BAR))
    83     "BAZ && PI || FOO && BAR")
    84   (test-parse
    85     '(or (and BAZ PI) (and (not FOO) BAR))
    86     "BAZ && PI || !FOO && BAR")
     59  (test-group "Logical"
     60    (test
     61      '(or (/ (* (+ 1 2) (f a b)) 27.9) PI)
     62      (read-sexp/string "(1 + 2) * f(a, b) / 27.9 || PI"))
     63    (test
     64      '(and (/ (* (+ 1 2) (f a b)) 27.9) PI)
     65      (read-sexp/string "(1 + 2) * f(a, b) / 27.9 && PI"))
     66    (test
     67      '(or (< a b) (and (f x) (> i (+ (modulo j 3) x))))
     68      (read-sexp/string "a < b || f(x) && i > j % 3 + x"))
     69    (test
     70      '(or (and BAZ PI) (and FOO BAR))
     71      (read-sexp/string "BAZ && PI || FOO && BAR"))
     72    (test
     73      '(or (and BAZ PI) (and (not FOO) BAR))
     74      (read-sexp/string "BAZ && PI || !FOO && BAR"))
     75  )
    8776
    88   (test-parse
    89     '(bitwise-ior a (bitwise-and b c) (bitwise-and (bitwise-not b) d))
    90     "a | b & c | ~b & d")
    91   (test-parse
    92     '(bitwise-xor (bitwise-ior a (bitwise-and b c)) (bitwise-ior (bitwise-not b) d))
    93     "a | b & c ^ ~b | d")
     77  (test-group "Bitwise"
     78    (test
     79      '(bitwise-ior a (bitwise-and b c) (bitwise-and (bitwise-not b) d))
     80      (read-sexp/string "a | b & c | ~b & d"))
     81    (test
     82      '(bitwise-xor (bitwise-ior a (bitwise-and b c)) (bitwise-ior (bitwise-not b) d))
     83      (read-sexp/string "a | b & c ^ ~b | d"))
     84  )
    9485
    95   (test-parse
    96     '(define f (lambda a (+ (first a) (second a)) (apply r a)))
    97     "f : \\a, first(a) + second(a), apply(r, a);")
     86  (test-group "Define & Lambda"
     87    (test
     88      '(define f (lambda a (+ (first a) (second a)) (apply r a)))
     89      (read-sexp/string "f := \\a, first(a) + second(a), apply(r, a);"))
    9890
    99   ;FIXME handle ratios ? / in a/b vs a / b ?
    100   #; ; "N/D (ratio) => (/ N D)"
    101   (test-parse '(* (+ 1 2) 1/5) "(1 + 2) * 1/5")
    102   ;#; ;
    103   (test-parse '(/ (* (+ 1 2) 1) 5) "(1 + 2) * 1/5")
     91    ;FIXME handle ratios / in a/b vs a / b ?
     92    #; ; "N/D (ratio) => (/ N D)"
     93    (test '(* (+ 1 2) 1/5) (read-sexp/string "(1 + 2) * 1/5"))
     94    ;#; ;
     95    (test '(/ (* (+ 1 2) 1) 5) (read-sexp/string "(1 + 2) * 1/5"))
    10496
    105   ;NOTE whitespace is not a delimiter
    106   (test 15 (eval (read-sexp-string "(1 +2)* 5;")))
    107   (test 15.0 (eval (read-sexp-string "(1.0+ 2) * 5")))
    108   (test 3/5 (eval (read-sexp-string "(1 + 2) *1/5")))
    109   (test 8 (eval (read-sexp-string "2 **3")))
     97    #; ;FIXME handle lambda arguments
     98    (test
     99      '(define f (lambda (a b) (- a b) (+ a b)))
     100      (with-input-from-string
     101        "f := \\(a,b), a-b, a + b;"
     102        read-sexps))
    110103
    111   (test
    112     '(begin (+ (first a) (second a)) (apply r a) (- 23 skidoo))
    113     (with-input-from-string
    114       "first(a) + second(a); apply(r, a); 23-skidoo"
    115       read-sexps))
     104    ;FIXME handle complex
     105  )
    116106
    117   ;FIXME handle infinities & nan
    118   (test
    119     '(begin (define f (lambda a (+ (first a) (second a)) (apply r a))) (f 1 (+ inf.0)))
    120     (with-input-from-string
    121      ;NOTE ;; is lambda-right-delim + expression-delim
    122       "f : \\a, first(a) + second(a), apply(r, a);; f(1,+inf.0)"
    123       read-sexps))
     107  (test-group "Multiple Expressions ;"
     108    (test
     109      '(begin (+ (first a) (second a)) (apply r a) (- 23 skidoo))
     110      (read-sexps/string
     111        "first(a) + second(a); apply(r, a); 23-skidoo"))
     112
     113    ;FIXME handle infinities & nan
     114    (test
     115      '(begin (define f (lambda a (+ (first a) (second a)) (apply r a))) (f 1 (+ inf.0)))
     116      (read-sexps/string
     117       ;NOTE ;; is lambda-right-delim + expression-delim
     118        "/* (define f (lambda a ...)) */ f := \\a, first(a) + second(a), apply(r, a);; f(1,+inf.0)"))
     119  )
     120
     121  (test-group "Evaluate Expression"
     122    ;NOTE whitespace is not a delimiter
     123    (test 15 (eval (read-sexp/string "(1 +2)* 5;")))
     124    (test 15.0 (eval (read-sexp/string "(1.0+ 2) * 5")))
     125    (test 3/5 (eval (read-sexp/string "(1 + 2) *1/5")))
     126    (test 8 (eval (read-sexp/string "2 **3")))
     127    (test #(1 2 3) (eval (read-sexp/string "[1,2,1+2]")))
     128    (test '(1 2 3) (eval (read-sexp/string "{1,2,1+2}")))
     129  )
     130
     131  (test-group "Evaluate Expressions ;"
     132    (test #(1 2 3) (eval (read-sexps/string "1+2; [1,2,1+2]")))
     133  )
    124134)
    125135
Note: See TracChangeset for help on using the changeset viewer.