Changeset 22116 in project for release/4/miniML/trunk


Ignore:
Timestamp:
12/25/10 17:54:44 (10 years ago)
Author:
Ivan Raikov
Message:

miniML: capitalizing element names in SXML representation

Location:
release/4/miniML/trunk
Files:
2 edited

Legend:

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

    r22026 r22116  
    726726(define (path->sxml p)
    727727  (cases path p
    728          (Pident (id) `(pident (@ (name ,(ident-name id)))))
    729          (Pdot (p s)  `(pdot (@ (name ,s)) (path ,(path->sxml p))))))
     728         (Pident (id) `(Pident (@ (name ,(ident-name id)))))
     729         (Pdot (p s)  `(Pdot (@ (name ,s)) (path ,(path->sxml p))))))
    730730
    731731
     
    736736(define (term->sxml t)
    737737  (cases term t
    738          (Const     (c)     `(const ,(const->sxml c)))
    739          (Longid    (p)     `(longid ,(path->sxml p)))
    740          (Function  (i t)   `(function (@ (formal ,(ident-name i))) (body ,(term->sxml t))))
    741          (Apply     (t1 t2) `(apply (left ,(term->sxml t1)) (right ,(term->sxml t2))))
    742          (Let0      (i v b) `(let0  (@ (name ,(ident-name i)))
     738         (Const     (c)     `(Const ,(const->sxml c)))
     739         (Longid    (p)     `(Longid ,(path->sxml p)))
     740         (Function  (i t)   `(Function (@ (formal ,(ident-name i))) (body ,(term->sxml t))))
     741         (Apply     (t1 t2) `(Apply (left ,(term->sxml t1)) (right ,(term->sxml t2))))
     742         (Let0      (i v b) `(Let0  (@ (name ,(ident-name i)))
    743743                                    (value ,(term->sxml v))
    744744                                    (body ,(term->sxml b))))
     
    757757(define (simple-type->sxml ty)
    758758  (cases simple-type ty
    759          (Tvar  (tv) `(tvar ,@(filter identity (tyvar->sxml tv))))
    760          (Tcon (p ts) `(tcon (path ,(path->sxml p))
     759         (Tvar  (tv)  `(Tvar ,@(filter identity (tyvar->sxml tv))))
     760         (Tcon (p ts) `(Tcon (path ,(path->sxml p))
    761761                             ,@(map (lambda (x) `(t ,(simple-type->sxml x))) ts)))))
    762762
    763763
    764764(define (valtype->sxml x)
    765   `(valtype ,@(map (lambda (q) `(qvar ,q)) (valtype-quantif x))
     765  `(Valtype ,@(map (lambda (q) `(qvar ,q)) (valtype-quantif x))
    766766            (body ,(simple-type->sxml (valtype-body x)))))
    767767
     
    769769(define (typedecl->sxml decl)
    770770  (let ((manifest (typedecl-manifest decl)))
    771     `(typedecl ,(kind->sxml (typedecl-kind decl))
     771    `(Typedecl ,(kind->sxml (typedecl-kind decl))
    772772               ,@(if manifest `((manifest ,(deftype->sxml manifest)))  `()))))
    773773
    774774
    775775(define (deftype->sxml x)
    776   `(deftype ,@(map (lambda (p) `(param ,p)) (deftype-params x))
     776  `(Deftype ,@(map (lambda (p) `(param ,p)) (deftype-params x))
    777777            (body ,(simple-type->sxml (deftype-body x)))))
    778778
     
    780780(define (modspec->sxml x)
    781781  (cases modspec x
    782          (Value_sig  (id valtype) `(value_sig (@ (name ,(ident-name id)))
     782         (Value_sig  (id valtype) `(Value_sig (@ (name ,(ident-name id)))
    783783                                              ,(valtype->sxml valtype)))
    784          (Type_sig   (id decl)    `(type_sig (@ (name ,(ident-name id)))
     784         (Type_sig   (id decl)    `(Type_sig (@ (name ,(ident-name id)))
    785785                                             ,(typedecl->sxml decl)))
    786          (Module_sig (id ty)      `(module_sig (@ (name ,(ident-name id)))
     786         (Module_sig (id ty)      `(Module_sig (@ (name ,(ident-name id)))
    787787                                               ,(modtype->sxml ty)))
    788788         ))
     
    791791(define (moddef->sxml d)
    792792  (cases moddef d
    793     (Value_def  (id term) `(value_def (@ (name ,(ident-name id)) )
    794                                       (term ,(term->sxml term))))
    795     (Type_def   (id kind defty) `(type_def (@ (name ,(ident-name id)) )
    796                                            ,(kind->sxml kind)
    797                                            ,(deftype->sxml defty)))
    798     (Module_def (id modterm) `(component_def (@ (name ,(ident-name id)) )
    799                                              (term ,(modterm->sxml modterm))))
     793    (Value_def  (id term)        `(Value_def (@ (name ,(ident-name id)) )
     794                                             (term ,(term->sxml term))))
     795
     796    (Type_def   (id kind defty)  `(Type_def (@ (name ,(ident-name id)) )
     797                                            ,(kind->sxml kind)
     798                                            ,(deftype->sxml defty)))
     799
     800    (Module_def (id modterm)     `(Component_def (@ (name ,(ident-name id)) )
     801                                                 (term ,(modterm->sxml modterm))))
    800802    ))
    801803
     
    803805(define (modtype->sxml mt)
    804806  (cases modtype mt
    805          (Signature (s) `(signature ,@(map modspec->sxml s)))
     807         (Signature (s) `(Signature ,@(map modspec->sxml s)))
    806808         (Functorty (id arg body)
    807                     `(functorty (@ (name ,(ident-name id)))
     809                    `(Functorty (@ (name ,(ident-name id)))
    808810                                (arg ,(modtype->sxml arg))
    809811                                (body ,(modtype->sxml body))))))
     
    812814(define (modterm->sxml t)
    813815  (cases modterm t
    814          (Modid      (p)        `(modid ,(path->sxml p)))
    815          (Structure  (s)        `(structure ,@(map (lambda (x) `(def ,(moddef->sxml x))) s)))
    816          (Functor    (id mty m) `(functor (@ (name ,(ident-name id)))
     816         (Modid      (p)        `(Modid ,(path->sxml p)))
     817         (Structure  (s)        `(Structure ,@(map (lambda (x) `(def ,(moddef->sxml x))) s)))
     818         (Functor    (id mty m) `(Functor (@ (name ,(ident-name id)))
    817819                                          (type ,(modtype->sxml mty))
    818820                                          (body ,(modterm->sxml m))))
    819          (Mapply     (m1 m2) `(modapply (left ,(modterm->sxml m1))
     821         (Mapply     (m1 m2) `(Modapply (left ,(modterm->sxml m1))
    820822                                        (right ,(modterm->sxml m2))))
    821          (Constraint (m mty) `(constraint (body ,(modterm->sxml m))
     823         (Constraint (m mty) `(Constraint (body ,(modterm->sxml m))
    822824                                          (type ,(modtype->sxml mty))))
    823825         ))
  • release/4/miniML/trunk/miniMLeval.scm

    r21521 r22116  
    265265
    266266      (cases value v
    267              (Const_v     (c)       `(const ,(const->sxml c)))
     267             (Const_v     (c)       `(Const ,(const->sxml c)))
    268268             
    269              (Prim_v      (proc)    `(prim))
     269             (Prim_v      (proc)    `(Prim))
    270270             
    271271             (Tuple_v      (slots)   (if (null? slots) `(null)
    272                                         `(tuple (left ,(value->sxml (car slots)))
     272                                        `(Tuple (left ,(value->sxml (car slots)))
    273273                                                (right ,(value->sxml (cdr slots))))))
    274274             
    275275             (Closure_v   (body env)
    276                             `(closure (body ,(term->sxml body))
     276                            `(Closure (body ,(term->sxml body))
    277277                                      (env  ,@(eval-env->sxml env))))
    278278             ))
     
    281281  (cases modval v
    282282         (Structure_v (env)
    283                       `(component (@ (name ,name)) ,(eval-env->sxml env)))
     283                      `(Component (@ (name ,name)) . ,(eval-env->sxml env)))
    284284         (Mclosure_v  (body env)
    285                       `(modclosure  (@ (name ,name))
     285                      `(Modclosure  (@ (name ,name))
    286286                                    (body ,(modterm->sxml body))
    287                                     (env ,@(eval-env->sxml env))))))
     287                                    (env . ,@(eval-env->sxml env))))))
    288288
    289289(define (eval-env-entry->sxml x)
     
    291291        (v  (cdr x)))
    292292    (cond ((value? v)
    293            `(binding (@ (name ,(ident-name id))) (value ,(value->sxml v))))
     293           `(Binding (@ (name ,(ident-name id))) (value ,(value->sxml v))))
    294294          ((moddef? v)
    295295           (moddef->sxml v))
Note: See TracChangeset for help on using the changeset viewer.