Lines Matching refs:exp
1587 BC_is_reserved_name exp =
1588 if MEM exp (MAP Sym macro_names) then Val 0 else
1589 if MEM exp (MAP Sym reserved_names) then exp else Sym "NIL"`;
1625 ``!exp. mc_is_reserved_name exp = BC_is_reserved_name exp``,
1939 BC_expand_macro (temp:SExp,task,exp,a,ret,consts,xs) =
1940 let temp = exp in
1941 let exp = CAR exp in
1942 if exp = Sym "FIRST" then
1943 let exp = Dot (Sym "CAR") (CDR temp) in
1944 (Sym "NIL",task,exp,a,ret,consts,xs) else
1945 if exp = Sym "SECOND" then
1946 let exp = Dot (Sym "FIRST") (Dot (Dot (Sym "CDR") (CDR temp)) (Sym "NIL")) in
1947 (Sym "NIL",task,exp,a,ret,consts,xs) else
1948 if exp = Sym "THIRD" then
1949 let exp = Dot (Sym "SECOND") (Dot (Dot (Sym "CDR") (CDR temp)) (Sym "NIL")) in
1950 (Sym "NIL",task,exp,a,ret,consts,xs) else
1951 if exp = Sym "FOURTH" then
1952 let exp = Dot (Sym "THIRD") (Dot (Dot (Sym "CDR") (CDR temp)) (Sym "NIL")) in
1953 (Sym "NIL",task,exp,a,ret,consts,xs) else
1954 if exp = Sym "FIFTH" then
1955 let exp = Dot (Sym "FOURTH") (Dot (Dot (Sym "CDR") (CDR temp)) (Sym "NIL")) in
1956 (Sym "NIL",task,exp,a,ret,consts,xs) else
1957 if exp = Sym "LET" then
1959 let (nil,vars,exps,zero,xs) = mc_map_car (CAR (CDR temp), exp, exp, exp, xs) in
1961 let exp = Dot lam exps in
1969 (Sym "NIL",task,exp,a,ret,consts,xs) else
1970 if exp = Sym "LET*" then
1971 let exp = CAR (CDR temp) in
1972 (if exp = Sym "NIL" then
1973 let exp = CAR (CDR (CDR temp)) in
1974 (Sym "NIL",task,exp,a,ret,consts,xs)
1976 let rest = CDR exp in
1977 let head = CAR exp in
1980 let exp = Dot (Sym "LET") (Dot assigns (Dot (let_star) (Sym "NIL"))) in
1981 (Sym "NIL",task,exp,a,ret,consts,xs)) else
1982 if exp = Sym "COND" then
1983 let exp = CDR temp in
1984 (if exp = Sym "NIL" then
1985 let exp = Dot (Sym "QUOTE") (Dot (Sym "NIL") (Sym "NIL")) in
1986 (Sym "NIL",task,exp,a,ret,consts,xs)
1988 let rest = CDR exp in
1989 let head = CAR exp in
1991 let exp = Dot (CAR (CDR head)) (Dot rest (Sym "NIL")) in
1992 let exp = Dot (Sym "IF") (Dot (CAR head) exp) in
1993 (Sym "NIL",task,exp,a,ret,consts,xs)) else
1994 if exp = Sym "AND" then
1995 let exp = CDR temp in
1996 (if exp = Sym "NIL" then
1997 let exp = Dot (Sym "QUOTE") (Dot (Sym "T") (Sym "NIL")) in
1998 (Sym "NIL",task,exp,a,ret,consts,xs)
2000 let rest = CDR exp in
2001 let head = CAR exp in
2003 let exp = list2sexp
2007 (Sym "NIL",task,exp,a,ret,consts,xs)
2009 let exp = head in
2010 (Sym "NIL",task,exp,a,ret,consts,xs)) else
2011 if exp = Sym "LIST" then
2012 let exp = CDR temp in
2013 (if exp = Sym "NIL" then
2014 let exp = Dot (Sym "QUOTE") (Dot (Sym "NIL") (Sym "NIL")) in
2015 (Sym "NIL",task,exp,a,ret,consts,xs)
2017 let rest = CDR exp in
2018 let head = CAR exp in
2019 let exp = list2sexp
2022 (Sym "NIL",task,exp,a,ret,consts,xs)) else
2023 if exp = Sym "DEFUN" then
2027 let exp = list2sexp [Sym "DEFINE"; arg1; arg2; arg3] in
2028 (Sym "NIL",task,exp,a,ret,consts,xs)) else
2031 fun sexp_lets exp = let
2033 fun flatten exp =
2034 if is_var exp then ([],exp) else
2035 if can (match_term ``Dot x y``) exp then let
2036 val (xs1,x1) = flatten (cdr (car exp))
2037 val (xs2,x2) = flatten (cdr exp)
2041 if can (match_term ``CAR x``) exp then let
2042 val (xs1,x1) = flatten (cdr exp)
2046 if can (match_term ``CDR x``) exp then let
2047 val (xs1,x1) = flatten (cdr exp)
2051 if ((can (match_term ``Sym "NIL"``) exp) orelse
2052 (can (match_term ``Sym "T"``) exp)) then let
2054 in ([(v,exp)], v) end else
2055 if can (match_term ``Sym x``) exp then let
2057 in ([(``x0:SExp``,exp),(v,``x0:SExp``)], v) end else
2058 ([],exp)
2089 val result = full exp
2090 val thm = SIMP_CONV std_ss [LET_DEF] (mk_eq(result,expand exp))
2490 BC_aux_ev (temp:SExp,task,exp,a,ret,consts:SExp,xs,xs1,code) =
2491 if isSym exp then
2492 (let (t1,loc,t2,t3) = mc_alist_lookup (task,Val 0,exp,a) in
2498 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code)
2504 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code))
2505 else if CAR exp = Sym "IF" then
2507 let xs = CAR exp::Dot a (CDR (CDR exp))::temp::xs in (* put if on todo list *)
2508 let exp = CAR (CDR exp) in
2510 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code)
2511 else if CAR exp = Sym "OR" then
2512 if ~(isDot (CDR exp)) then
2513 let exp = Sym "NIL" in
2514 let code = WRITE_CODE code [iCONST_SYM (getSym exp)] in
2518 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code)
2521 let xs = CAR exp::Dot a (CDR (CDR exp))::temp::xs in (* put if on todo list *)
2522 let exp = CAR (CDR exp) in
2524 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code)
2525 else if isQuote exp then
2526 let exp = CAR (CDR exp) in
2527 if isVal exp then
2528 let code = WRITE_CODE code [iCONST_NUM (getVal exp)] in
2532 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code)
2533 else if isSym exp then
2534 let code = WRITE_CODE code [iCONST_SYM (getSym exp)] in
2538 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code)
2540 let (task,xs1) = (Val (LENGTH xs1),xs1 ++ [exp]) in
2546 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code)
2547 else if isDot (CAR exp) then (* lambda *)
2549 let xs = ^COMPILE_LAM1::exp::temp::a::xs in
2550 let exp = CDR exp in
2553 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code)
2554 else if isVal exp then
2555 let exp = Dot (Sym "QUOTE") (Dot exp (Sym "NIL")) in
2556 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code)
2558 let temp = exp in
2559 let exp = CAR exp in
2560 let exp = BC_is_reserved_name exp in
2561 if exp = Sym "NIL" then (* user-defined function *)
2566 let exp = CDR temp in
2568 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code)
2576 let exp = CDR temp in
2578 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code))
2580 (if exp = Val 0 then (* macro *)
2581 let exp = temp in
2583 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code)
2586 let exp = temp in
2589 let temp = Dot (CAR exp) temp in
2592 let exp = CDR exp in
2594 (Sym "NIL",task,exp,a,ret,consts,xs,xs1,code))`;
2855 BC_aux_ap (temp:SExp,task:SExp,exp,a,ret,xs:SExp list,code) =
2856 if CAR exp = Sym "DEFINE" then
2859 let (temp,a) = mc_drop (CDR exp,a) in
2862 (Sym "NIL", task,exp,a,ret,xs,code)
2863 else if CAR exp = Sym "PRINT" then
2865 let (t1,code) = mc_cons_list (CDR exp,code) in
2873 let (temp,a) = mc_drop (CDR exp,a) in
2876 (Sym "NIL", task,exp,a,ret,xs,code)
2877 else if CAR exp = Sym "ERROR" then
2879 let (t1,code) = mc_cons_list (CDR exp,code) in
2886 let (temp,a) = mc_drop (CDR exp,a) in
2889 (Sym "NIL", task,exp,a,ret,xs,code)
2890 else if CAR exp = Sym "FUNCALL" then
2891 let task = LISP_SUB (CDR exp) (Val 1) in
2893 let code = WRITE_CODE code [iLOAD (getVal (CDR exp))] in
2897 let (temp,a) = mc_drop (CDR exp,a) in
2900 (Sym "NIL", task,exp,a,ret,xs,code)
2902 let (task,temp,code) = mc_primitive (CAR exp,CDR exp,code) in
2904 let (temp,a) = mc_drop (CDR exp,a) in
2907 (Sym "NIL", task,exp,a,ret,xs,code)`;
3033 BC_aux_call (temp:SExp,task:SExp,exp:SExp,a:SExp,ret:SExp,consts:SExp,xs:SExp list,code) =
3034 let (t1,temp,t2) = mc_fun_lookup (task,CDR consts,CAR exp) in
3035 let (t1,ll) = mc_length (CDR exp,Val 0) in
3042 let code = WRITE_CODE code [iCONST_SYM (getSym (CAR exp))] in
3043 let exp = Sym "NIL" in
3046 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3050 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3052 let exp = Sym "NIL" in
3055 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3059 (Sym "NIL",task,exp,a,ret,consts,xs,code)`;
3144 BC_aux_tail (temp:SExp,task,exp,a,ret,consts,xs,code) =
3147 let xs = ^COMPILE_LAM2::exp::xs in
3148 let (t1,l) = mc_length (CAR (CDR (CAR exp)),Val 0) in
3150 let (t1,t2,a) = mc_rev_append (CAR (CDR (CAR exp)),temp,a) in
3152 let exp = CAR (CDR (CDR (CAR exp))) in
3153 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3161 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3163 let (t1,l) = mc_length (CAR (CDR (CAR exp)),Val 0) in
3165 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3167 let ret = exp in
3169 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3176 let xs = exp::xs in
3177 let exp = Val 0 in
3178 let code = WRITE_CODE code [iJNIL (getVal exp)] in
3179 let exp = HD xs in
3180 let a = CAR exp in
3181 let exp = CDR exp in
3183 let exp = CAR exp in
3185 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3195 let a = Dot (Val 0) (CAR exp) in
3199 let xs = exp::xs in
3205 let exp = HD xs in
3206 let a = CAR exp in
3207 let exp = CDR exp in
3209 let exp = Dot (Sym "OR") exp in
3211 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3212 else if task = ^COMPILE_IF2 then (* exp for first case has been compiled *)
3217 let xs = exp::xs in
3218 let exp = Val 0 in
3219 let code = WRITE_CODE code [iJUMP (getVal exp)] in
3222 let exp = HD xs in
3223 let a = CAR exp in
3225 let exp = CDR exp in
3228 let exp = CAR (CDR exp) in
3230 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3231 else if task = ^COMPILE_IF3 then (* exp for fst and snd case have been compiled *)
3232 let a = exp in
3235 let exp = HD xs in
3238 let code = REPLACE_CODE code (getVal exp) (iJUMP (getVal task)) in
3239 let exp = Sym "NIL" in
3241 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3243 let a = exp in
3246 let exp = HD xs in
3249 let code = REPLACE_CODE code (getVal exp) (iJUMP (getVal task)) in
3250 let exp = Sym "NIL" in
3252 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3254 let al = CAR exp in
3255 let xl = CDR exp in
3260 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3263 let (temp,task,exp,a,ret,consts,xs,code) = BC_aux_call (temp,task,exp,a,ret,consts,xs,code) in
3264 (Sym "NIL",task,exp,a,ret,consts,xs,code)
3267 let (temp,task,exp,a,ret,consts,xs) = mc_expand_macro (temp,task,exp,a,ret,consts,xs) in
3269 (Sym "NIL",task,exp,a,ret,consts,xs,code)`;
3471 BC_aux1 (temp:SExp,task,exp,a,ret,consts,xs,xs1,code) =
3473 let (temp,task,exp,a,ret,consts,xs,xs1,code) = BC_aux_ev (temp,task,exp,a,ret,consts,xs,xs1,code) in
3474 (temp,task,exp,a,ret,consts,xs,xs1,code)
3476 if isDot exp then
3477 let xs = ^COMPILE_EVL::(CDR exp)::xs in
3478 let exp = CAR exp in
3480 (temp,task,exp,a,ret,consts,xs,xs1,code)
3483 (temp,task,exp,a,ret,consts,xs,xs1,code)
3485 let (temp,task,exp,a,ret,xs,code) = BC_aux_ap (temp,task,exp,a,ret,xs,code) in
3486 (temp,task,exp,a,ret,consts,xs,xs1,code)
3488 let (temp,task,exp,a,ret,consts,xs,code) = BC_aux_tail (temp,task,exp,a,ret,consts,xs,code) in
3489 (temp,task,exp,a,ret,consts,xs,xs1,code)`;
4561 (* exp to evaluate in x0 *)