Changeset 19219 in project


Ignore:
Timestamp:
08/09/10 11:23:27 (10 years ago)
Author:
Ivan Raikov
Message:

fixes to static-modules/miniML

Location:
release/4
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/miniML/trunk/examples/NineMLsignal.scm

    r19218 r19219  
    6868                                 (Longid (Pident (ident-create "x"))))))
    6969
     70           (Value_def (ident-create "sense")
     71                      (Function (ident-create "x")
     72                                (Apply
     73                                 (Apply
     74                                  (Longid (Pident (ident-create "pair")))
     75                                  (Const 'sense))
     76                                 (Longid (Pident (ident-create "x"))))))
     77
    7078          ))
    7179        )
    7280   
    73     (print "eval-env = " (eval-env))
    7481    (let ((modname (ident-create module-name)))
    7582      (enter-module modname  (Signature sig))
  • release/4/miniML/trunk/miniMLeval.scm

    r19218 r19219  
    3030         value? Const_v Closure_v Prim_v Data_v
    3131         core-eval-normal-order
    32          make-env-eval-normal-order
     32         eval-normal-order-initialize
    3333         mod-eval-normal-order
    3434         )
     
    8888    (ident-add id val env)))
    8989
    90 (core-initialize enter-typedecl enter-valtype)
    9190
    9291;; call-by-value interpreter
     
    153152
    154153           (Longid (p)
    155                    (print "eval: Longid: p = " p)
    156                    (print "eval: Longid: env = " env)
    157154                   (let ((vp (path-find-val p env)))
    158                      (print "eval: Longid: vp = " vp)
    159155                     (or (sloteval eval vp)
    160156                         (error 'ML-core-eval "unknown id" p))))
    161157
    162            (Function (_ _)  (begin
    163                               (print "eval: Function: env = " env)
    164                               (Closure_v t env)))
     158           (Function (_ _)  (Closure_v t env))
    165159
    166160           (Apply (funct arg)
    167                   (print "eval: Apply: funct = " funct)
    168                   (print "eval: Apply: (eval funct env) = " (eval funct env))
    169161                  (cases value (eval funct env)
    170 
    171162                         (Closure_v (body env1)
    172                                     (print "eval: Apply: body = " body)
    173163                            (cases term body
    174164                                   (Function (param body)
     
    199189      (let ((name (cadr x))
    200190            (op   (caddr x))
     191            (%enter-val  (r 'enter-val))
    201192            (%lambda  (r 'lambda))
    202193            (%if      (r 'if))
     
    210201                  (,%let* ((xid   (cases term x (Longid (id1) id1) (else #f)))
    211202                           (xid1  (or xid (gensym 'x)))
    212                            (xenv1 (if xid xenv (enter-val xid1 (make-parameter (Closure_v x xenv)) xenv)))
     203                           (xenv1 (if xid xenv (,%enter-val xid1 (make-parameter (Closure_v x xenv)) xenv)))
    213204                           (x     (if xid arg (Closure_v (Longid (Pident (ident-create xid1))) xenv1))))
    214205                          (Prim_v
     
    247238
    248239
    249 (define (make-env-eval-normal-order enter-val)
     240(define (eval-normal-order-initialize enter-val)
    250241
    251242  (define eval core-eval-normal-order)
  • release/4/miniML/trunk/miniMLmain.scm

    r19218 r19219  
    5454
    5555(core-initialize enter-typedecl enter-valtype)
    56 (make-env-eval-normal-order enter-val)
     56(eval-normal-order-initialize enter-val)
    5757
    5858(define (enter-module id mty)
     
    7373              (value (required NAME:FILE)
    7474                     (predicate ,(lambda (x)
    75                                    (print "option pred: x = " x)
    7675                                   (let ((v  (string-split x ":")))
    77                                      (print "option pred: v = " v)
    7876                                     (and (pair? v) (file-exists? (cadr v))))))
    7977                     (transformer ,(lambda (x)
    80                                      (print "option xform: x = " x)
    8178                                     (string-split x ":")))))
    8279
     
    112109        (for-each
    113110         (lambda (mod)
    114            (print "mod = " mod)
    115111           (##sys#load (cadr mod) #f #f)
    116112           (module-initialize (car mod) enter-module init-eval-env ))
     
    122118           (let ((defs (parse 'miniML (open-input-file operand))))
    123119             (let* ((scoped-defs  (scope-moddef (init-scope) defs))
    124                     (mty          (type-moddef (init-env) '() scoped-defs))
     120                    (mty         
     121                     (type-moddef (init-env) '() scoped-defs))
     122                    (final-eval-env
     123                     (lset-difference
     124                      (lambda (x y) (ident-equal? (car x) (car y)))
     125                      (mod-eval-normal-order (init-eval-env) scoped-defs)
     126                      (init-eval-env)))
    125127                    )
    126128               (pp mty)
    127                (pp (init-eval-env))
    128                (mod-eval-normal-order (init-eval-env) scoped-defs)
     129               (pp final-eval-env)
    129130               )))
    130131         operands))))
  • release/4/static-modules/static-modules.scm

    r19218 r19219  
    821821                       (let* ((env0 env)
    822822                              (env1 (fold eval-moddef env0 str))
    823                               (menv (lset-difference env1 env0
    824                                                      (lambda (x y) (equal? (ident-name (car x))
    825                                                                            (ident-name (car y)))))))
    826                          (Structure_v (fold eval-moddef menv str))))
     823                              (menv (lset-difference (lambda (x y) (ident-equal? (car x) (car y))) env1 env0)))
     824                         (Structure_v menv)))
    827825
    828826           (Functor    (id mty mt)
     
    854852                       
    855853           (Module_def (id mt)
    856                        (print "Module_def: id = " id)
    857                        (print "Module_def: env = " env)
    858854                       (enter-val id (eval-modterm mt env) env))
    859855           ))
    860856
    861857  (lambda (env dlst)
    862     (print "mod-eval: env = " env)
    863858    (fold eval-moddef env dlst))
    864859)
Note: See TracChangeset for help on using the changeset viewer.