lambda_mountain 1.13.53

Compiler Backend / Programming Language Scaffolding
Documentation 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58


print := λ(: ctx FContext). (: (tail(
   (print 'Fragment\sContext:\n_s)
   (while (non-zero ctx) (match ctx (
      ()
      ( (FCtxBind( rst k kt kf )) (tail(
         (print k)(print '\s:\s_s)(print kt)(print '\n_s)(print kf)
         (set ctx rst)
      )))
   )))
)) Nil);

fragment-context::new := λ. (: (tail(
   (let r FCtxEOF)
   r
)) FContext);

fragment-context::lookup := λ(: ctx FContext)(: k String)(: kt Type)(: sloc AST). (: (tail(
   (let r (fragment::new()))
   (let found False_u8)
   (while (non-zero ctx) (match ctx (
      ()
      ( (FCtxBind( rst rk rt rf )) (
         (if (==( k rk )) (
            (match (slot( rt 'Arrow_s )) (
               ()
               ( (TGround( 'Arrow_s (TypeSeq( (TypeSeq( TypeEOF domaint )) ranget )) )) (
                  (if (can-unify( domaint kt )) (tail(
                     (set r rf)
                     (set found True_u8)
                     (set ctx FCtxEOF)
                  )) (set ctx rst))
               ))
               ( _ (tail(
                  (set r rf)
                  (set found True_u8)
                  (set ctx FCtxEOF)
               )))
            ))
         ) (
            (set ctx rst)
         ))
      ))
   )))
   (if (==( found True_u8 )) () (tail(
      (print 'Context::lookup\s_s)(print k)(print '\s:\s_s)(print kt)(print '\n_s)
      (exit-error( 'Context::lookup\sCould\sNot\sFind\sSymbol_s sloc ))
   )))
   r
)) Fragment);

fragment-context::bind := λ(: ctx FContext)(: k String)(: kt Type)(: f Fragment). (: (tail(
   (let new-ctx (FCtxBind(
      (close ctx)
      k kt f
   )))
   new-ctx
)) FContext);